Commit 489c6e19 by Arnaud Charlet

[multiple changes]

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb,
	restrict.ads: Minor reformatting.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* lib-xref.adb: Retrieve original name of classwide type if any.

2013-04-12  Thomas Quinot  <quinot@adacore.com>

	* exp_ch11.ads: Minor reformatting.

From-SVN: r197910
parent a7e68e7f
2013-04-12 Robert Dewar <dewar@adacore.com>
* checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb,
restrict.ads: Minor reformatting.
2013-04-12 Ed Schonberg <schonberg@adacore.com>
* lib-xref.adb: Retrieve original name of classwide type if any.
2013-04-12 Thomas Quinot <quinot@adacore.com>
* exp_ch11.ads: Minor reformatting.
2013-04-12 Hristian Kirtchev <kirtchev@adacore.com> 2013-04-12 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb: Alphabetize subprogram bodies in this unit. Add * aspects.adb: Alphabetize subprogram bodies in this unit. Add
......
...@@ -96,4 +96,5 @@ package Exp_Ch11 is ...@@ -96,4 +96,5 @@ package Exp_Ch11 is
-- handler (and restriction No_Exception_Propagation is set), or if there -- handler (and restriction No_Exception_Propagation is set), or if there
-- is a local handler marking that it has a local raise. E is the entity -- is a local handler marking that it has a local raise. E is the entity
-- of the corresponding exception. -- of the corresponding exception.
end Exp_Ch11; end Exp_Ch11;
...@@ -1364,6 +1364,23 @@ package body Lib.Xref is ...@@ -1364,6 +1364,23 @@ package body Lib.Xref is
then then
Tref := Etype (Tref); Tref := Etype (Tref);
-- Another special case: an object of a classwide type
-- initialized with a tag-indeterminate call gets a subtype
-- of the classwide type during expansion. See if the original
-- type in the declaration is named, and return it instead
-- of going to the root type.
if Ekind (Tref) = E_Class_Wide_Subtype
and then Nkind (Parent (Ent)) = N_Object_Declaration
and then
Nkind (Original_Node (Object_Definition (Parent (Ent))))
= N_Identifier
then
Tref :=
Entity
(Original_Node ((Object_Definition (Parent (Ent)))));
end if;
-- For anything else, exit -- For anything else, exit
else else
......
...@@ -1041,11 +1041,13 @@ package body Repinfo is ...@@ -1041,11 +1041,13 @@ package body Repinfo is
Write_Str ("for "); Write_Str ("for ");
List_Name (Ent); List_Name (Ent);
Write_Str ("'" & Attr_Name & " use System."); Write_Str ("'" & Attr_Name & " use System.");
if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then
Write_Str ("High"); Write_Str ("High");
else else
Write_Str ("Low"); Write_Str ("Low");
end if; end if;
Write_Line ("_Order_First;"); Write_Line ("_Order_First;");
end List_Attr; end List_Attr;
...@@ -1060,6 +1062,7 @@ package body Repinfo is ...@@ -1060,6 +1062,7 @@ package body Repinfo is
if Is_Record_Type (Ent) then if Is_Record_Type (Ent) then
List_Attr ("Bit_Order"); List_Attr ("Bit_Order");
end if; end if;
List_Attr ("Scalar_Storage_Order"); List_Attr ("Scalar_Storage_Order");
end if; end if;
end List_Scalar_Storage_Order; end List_Scalar_Storage_Order;
......
...@@ -75,7 +75,7 @@ package body Restrict is ...@@ -75,7 +75,7 @@ package body Restrict is
(others => False); (others => False);
No_Use_Of_Attribute_Set : Boolean := False; No_Use_Of_Attribute_Set : Boolean := False;
-- Indicates that No_Use_Of_Attribute was set at least once. -- Indicates that No_Use_Of_Attribute was set at least once
No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr := No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
(others => No_Location); (others => No_Location);
...@@ -84,7 +84,7 @@ package body Restrict is ...@@ -84,7 +84,7 @@ package body Restrict is
(others => False); (others => False);
No_Use_Of_Pragma_Set : Boolean := False; No_Use_Of_Pragma_Set : Boolean := False;
-- Indicates that No_Use_Of_Pragma was set at least once. -- Indicates that No_Use_Of_Pragma was set at least once
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
...@@ -322,7 +322,7 @@ package body Restrict is ...@@ -322,7 +322,7 @@ package body Restrict is
return; return;
end if; end if;
-- If nothing set, nothing to check. -- If nothing set, nothing to check
if not No_Use_Of_Attribute_Set then if not No_Use_Of_Attribute_Set then
return; return;
...@@ -334,8 +334,7 @@ package body Restrict is ...@@ -334,8 +334,7 @@ package body Restrict is
Error_Msg_Node_1 := N; Error_Msg_Node_1 := N;
Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id); Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id);
Error_Msg_N Error_Msg_N
("<violation of restriction `No_Use_Of_Attribute '='> &`#", ("<violation of restriction `No_Use_Of_Attribute '='> &`#", N);
N);
end if; end if;
end Check_Restriction_No_Use_Of_Attribute; end Check_Restriction_No_Use_Of_Attribute;
...@@ -356,7 +355,7 @@ package body Restrict is ...@@ -356,7 +355,7 @@ package body Restrict is
return; return;
end if; end if;
-- If nothing set, nothing to check. -- If nothing set, nothing to check
if not No_Use_Of_Pragma_Set then if not No_Use_Of_Pragma_Set then
return; return;
...@@ -368,8 +367,7 @@ package body Restrict is ...@@ -368,8 +367,7 @@ package body Restrict is
Error_Msg_Node_1 := Id; Error_Msg_Node_1 := Id;
Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id); Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id);
Error_Msg_N Error_Msg_N
("<violation of restriction `No_Use_Of_Pragma '='> &`#", ("<violation of restriction `No_Use_Of_Pragma '='> &`#", Id);
Id);
end if; end if;
end Check_Restriction_No_Use_Of_Pragma; end Check_Restriction_No_Use_Of_Pragma;
...@@ -381,6 +379,10 @@ package body Restrict is ...@@ -381,6 +379,10 @@ package body Restrict is
function Chars_Is (E : Entity_Id; S : String) return Boolean; function Chars_Is (E : Entity_Id; S : String) return Boolean;
-- Return True iff Chars (E) matches S (given in lower case) -- Return True iff Chars (E) matches S (given in lower case)
--------------
-- Chars_Is --
--------------
function Chars_Is (E : Entity_Id; S : String) return Boolean is function Chars_Is (E : Entity_Id; S : String) return Boolean is
Nam : constant Name_Id := Chars (E); Nam : constant Name_Id := Chars (E);
begin begin
......
...@@ -414,8 +414,7 @@ package body Sem_Ch4 is ...@@ -414,8 +414,7 @@ package body Sem_Ch4 is
Check_Restriction (No_Allocators, N); Check_Restriction (No_Allocators, N);
-- Processing for No_Standard_Allocators_After_Elaboration, loop to -- Processing for No_Standard_Allocators_After_Elaboration, loop to
-- look at enclosing context, checking task case and main subprogram -- look at enclosing context, checking task/main subprogram case.
-- case.
C := N; C := N;
P := Parent (C); P := Parent (C);
......
...@@ -3339,14 +3339,11 @@ package body Sem_Elab is ...@@ -3339,14 +3339,11 @@ package body Sem_Elab is
if Nkind (Item) = N_Pragma if Nkind (Item) = N_Pragma
and then Pragma_Name (Item) = Name_Elaborate_All and then Pragma_Name (Item) = Name_Elaborate_All
then then
-- Return if some previous error on the pragma itself -- Return if some previous error on the pragma itself. The
-- The pragma may be unanalyzed, because of a previous error, -- pragma may be unanalyzed, because of a previous error, or
-- or if it is the context of a subunit, inherited by its -- if it is the context of a subunit, inherited by its parent.
-- parent.
if Error_Posted (Item) if Error_Posted (Item) or else not Analyzed (Item) then
or else not Analyzed (Item)
then
return; return;
end if; end if;
......
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