Commit c99ab5f9 by Hristian Kirtchev Committed by Arnaud Charlet

exp_attr.adb, [...]: Minor reformatting.

2017-09-06  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb, sem_util.adb, sem_attr.adb, sem_ch6.adb, sem_ch8.adb,
	sem_warn.adb: Minor reformatting.

From-SVN: r251772
parent 3c0ae05d
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb, sem_util.adb, sem_attr.adb, sem_ch6.adb, sem_ch8.adb,
sem_warn.adb: Minor reformatting.
2017-09-06 Ed Schonberg <schonberg@adacore.com> 2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous * sem_warn.adb (Warn_On_Overlapping_Actuals): Refine previous
......
...@@ -1597,8 +1597,8 @@ package body Exp_Attr is ...@@ -1597,8 +1597,8 @@ package body Exp_Attr is
procedure Rewrite_Object_Reference_Image procedure Rewrite_Object_Reference_Image
(Name : Name_Id; (Name : Name_Id;
Str_Typ : Entity_Id); Str_Typ : Entity_Id);
-- Rewrite an Image attribute applied to an object reference for -- AI12-00124: Rewrite attribute 'Image when it is applied to an object
-- AI12-00124 into an attribute applied to a type. -- reference as an attribute applied to a type.
procedure Rewrite_Stream_Proc_Call (Pname : Entity_Id); procedure Rewrite_Stream_Proc_Call (Pname : Entity_Id);
-- Rewrites a stream attribute for Read, Write or Output with the -- Rewrites a stream attribute for Read, Write or Output with the
...@@ -1610,7 +1610,8 @@ package body Exp_Attr is ...@@ -1610,7 +1610,8 @@ package body Exp_Attr is
procedure Rewrite_Object_Reference_Image procedure Rewrite_Object_Reference_Image
(Name : Name_Id; (Name : Name_Id;
Str_Typ : Entity_Id) is Str_Typ : Entity_Id)
is
begin begin
Rewrite (N, Rewrite (N,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
......
...@@ -364,8 +364,8 @@ package body Sem_Attr is ...@@ -364,8 +364,8 @@ package body Sem_Attr is
-- Check that P is an object reference -- Check that P is an object reference
procedure Check_Object_Reference_Image (Str_Typ : Entity_Id); procedure Check_Object_Reference_Image (Str_Typ : Entity_Id);
-- Verify that the prefix of an image attribute is an object reference -- Verify that the prefix of attribute 'Image is an object reference and
-- and set the Etype of the prefix to that specified by Str_Typ. -- set the type of the prefix to Str_Typ.
procedure Check_PolyORB_Attribute; procedure Check_PolyORB_Attribute;
-- Validity checking for PolyORB/DSA attribute -- Validity checking for PolyORB/DSA attribute
......
...@@ -6691,16 +6691,16 @@ package body Sem_Ch6 is ...@@ -6691,16 +6691,16 @@ package body Sem_Ch6 is
if not Raise_Exception_Call then if not Raise_Exception_Call then
if GNATprove_Mode then if GNATprove_Mode then
Error_Msg_N Error_Msg_N
("implied return after this statement " ("implied return after this statement would have raised "
& "would have raised Program_Error", Last_Stm); & "Program_Error", Last_Stm);
-- In normal compilation mode, do not warn on a generated -- In normal compilation mode, do not warn on a generated call
-- call (e.g. in the body of a renaming as completion). -- (e.g. in the body of a renaming as completion).
elsif Comes_From_Source (Last_Stm) then elsif Comes_From_Source (Last_Stm) then
Error_Msg_N Error_Msg_N
("implied return after this statement " ("implied return after this statement will raise "
& "will raise Program_Error??", Last_Stm); & "Program_Error??", Last_Stm);
end if; end if;
Error_Msg_Warn := SPARK_Mode /= On; Error_Msg_Warn := SPARK_Mode /= On;
......
...@@ -2947,7 +2947,7 @@ package body Sem_Ch8 is ...@@ -2947,7 +2947,7 @@ package body Sem_Ch8 is
Set_Public_Status (New_S); Set_Public_Status (New_S);
if No_Return (Rename_Spec) if No_Return (Rename_Spec)
and then not No_Return (Entity (Nam)) and then not No_Return (Entity (Nam))
then then
Error_Msg_N ("renaming completes a No_Return procedure", N); Error_Msg_N ("renaming completes a No_Return procedure", N);
Error_Msg_N Error_Msg_N
......
...@@ -13782,9 +13782,10 @@ package body Sem_Util is ...@@ -13782,9 +13782,10 @@ package body Sem_Util is
P_Typ : Entity_Id) return Boolean P_Typ : Entity_Id) return Boolean
is is
begin begin
return Ada_Version > Ada_2005 return
and then Is_Object_Reference (Prefix) Ada_Version > Ada_2005
and then Is_Scalar_Type (P_Typ); and then Is_Object_Reference (Prefix)
and then Is_Scalar_Type (P_Typ);
end Is_Image_Applied_To_Object; end Is_Image_Applied_To_Object;
---------------------------- ----------------------------
...@@ -17066,9 +17067,10 @@ package body Sem_Util is ...@@ -17066,9 +17067,10 @@ package body Sem_Util is
if Ada_Version >= Ada_2005 if Ada_Version >= Ada_2005
and then Present (First_Formal (E)) and then Present (First_Formal (E))
and then No (Default_Value (First_Formal (E))) and then No (Default_Value (First_Formal (E)))
and then (Is_Controlling_Formal (First_Formal (E)) and then
or else Is_Class_Wide_Type (Etype (First_Formal (E))) (Is_Controlling_Formal (First_Formal (E))
or else Is_Anonymous_Access_Type (Etype (First_Formal (E)))) or else Is_Class_Wide_Type (Etype (First_Formal (E)))
or else Is_Anonymous_Access_Type (Etype (First_Formal (E))))
then then
Formal := Next_Formal (First_Formal (E)); Formal := Next_Formal (First_Formal (E));
while Present (Formal) loop while Present (Formal) loop
......
...@@ -3608,13 +3608,13 @@ package body Sem_Warn is ...@@ -3608,13 +3608,13 @@ package body Sem_Warn is
-- Local variables -- Local variables
Act1 : Node_Id; Act1 : Node_Id;
Act2 : Node_Id; Act2 : Node_Id;
Form1 : Entity_Id; Form1 : Entity_Id;
Form2 : Entity_Id; Form2 : Entity_Id;
Warn_Only : Boolean; Warn_Only : Boolean;
-- GNAT warns on overlapping in-out parameters even when there -- GNAT warns on overlapping in-out parameters even when there are no
-- sre no two in-out parameters of an elementary type, as stated in -- two in-out parameters of an elementary type, as stated in
-- RM 6.5.1 (17/2). -- RM 6.5.1 (17/2).
-- Start of processing for Warn_On_Overlapping_Actuals -- Start of processing for Warn_On_Overlapping_Actuals
...@@ -3625,8 +3625,8 @@ package body Sem_Warn is ...@@ -3625,8 +3625,8 @@ package body Sem_Warn is
return; return;
end if; end if;
-- The call is illegal only if there are at least two in-out -- The call is illegal only if there are at least two in-out parameters
-- parameters of the same elementary type. -- of the same elementary type.
Warn_Only := True; Warn_Only := True;
Form1 := First_Formal (Subp); Form1 := First_Formal (Subp);
...@@ -3727,11 +3727,10 @@ package body Sem_Warn is ...@@ -3727,11 +3727,10 @@ package body Sem_Warn is
or else not Is_Elementary_Type (Etype (Form1)) or else not Is_Elementary_Type (Etype (Form1))
-- debug flag -gnatd.E changes the error to a -- debug flag -gnatd.E changes the error to a warning
-- warning even in Ada 2012 mode. -- even in Ada 2012 mode.
or else Error_To_Warning or else Error_To_Warning
or else Warn_Only; or else Warn_Only;
declare declare
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment