From 42c57d558352f520e4d78c7a094a2b16a5d37f04 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 12 Apr 2013 13:19:15 +0000 Subject: [PATCH] 2013-04-12 Robert Dewar * checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb, restrict.ads: Minor reformatting. 2013-04-12 Ed Schonberg * lib-xref.adb: Retrieve original name of classwide type if any. 2013-04-12 Thomas Quinot * exp_ch11.ads: Minor reformatting. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@197910 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/checks.adb | 6 +++--- gcc/ada/exp_ch11.ads | 1 + gcc/ada/lib-xref.adb | 17 +++++++++++++++++ gcc/ada/repinfo.adb | 3 +++ gcc/ada/restrict.adb | 24 +++++++++++++----------- gcc/ada/restrict.ads | 6 +++--- gcc/ada/sem_ch4.adb | 3 +-- gcc/ada/sem_elab.adb | 11 ++++------- 9 files changed, 58 insertions(+), 26 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 80705e9..3a29f19 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2013-04-12 Robert Dewar + + * checks.adb, sem_elab.adb, repinfo.adb, sem_ch4.adb, restrict.adb, + restrict.ads: Minor reformatting. + +2013-04-12 Ed Schonberg + + * lib-xref.adb: Retrieve original name of classwide type if any. + +2013-04-12 Thomas Quinot + + * exp_ch11.ads: Minor reformatting. + 2013-04-12 Hristian Kirtchev * aspects.adb: Alphabetize subprogram bodies in this unit. Add diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index c8d900f..5544aad 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6242,9 +6242,9 @@ package body Checks is return; end if; - -- Do not insert checks within a predicate function. This will arise - -- if the current unit and the predicate function are being compiled - -- with validity checks enabled. + -- Do not insert checks within a predicate function. This will arise + -- if the current unit and the predicate function are being compiled + -- with validity checks enabled. if Present (Predicate_Function (Typ)) and then Current_Scope = Predicate_Function (Typ) diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index 96887e2..5f2f6b5 100644 --- a/gcc/ada/exp_ch11.ads +++ b/gcc/ada/exp_ch11.ads @@ -96,4 +96,5 @@ package Exp_Ch11 is -- 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 -- of the corresponding exception. + end Exp_Ch11; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index bf3f035..28ae480 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1364,6 +1364,23 @@ package body Lib.Xref is then 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 else diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index e800859..37dd5e4 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -1041,11 +1041,13 @@ package body Repinfo is Write_Str ("for "); List_Name (Ent); Write_Str ("'" & Attr_Name & " use System."); + if Bytes_Big_Endian xor Reverse_Storage_Order (Ent) then Write_Str ("High"); else Write_Str ("Low"); end if; + Write_Line ("_Order_First;"); end List_Attr; @@ -1060,6 +1062,7 @@ package body Repinfo is if Is_Record_Type (Ent) then List_Attr ("Bit_Order"); end if; + List_Attr ("Scalar_Storage_Order"); end if; end List_Scalar_Storage_Order; diff --git a/gcc/ada/restrict.adb b/gcc/ada/restrict.adb index 2e225f1..6502bb1 100644 --- a/gcc/ada/restrict.adb +++ b/gcc/ada/restrict.adb @@ -69,22 +69,22 @@ package body Restrict is -- Once set True, this is never turned off again. No_Use_Of_Attribute : array (Attribute_Id) of Source_Ptr := - (others => No_Location); + (others => No_Location); No_Use_Of_Attribute_Warning : array (Attribute_Id) of Boolean := - (others => False); + (others => 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 := (others => No_Location); No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean := - (others => False); + (others => 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 -- @@ -322,7 +322,7 @@ package body Restrict is return; end if; - -- If nothing set, nothing to check. + -- If nothing set, nothing to check if not No_Use_Of_Attribute_Set then return; @@ -334,8 +334,7 @@ package body Restrict is Error_Msg_Node_1 := N; Error_Msg_Warn := No_Use_Of_Attribute_Warning (A_Id); Error_Msg_N - (" &`#", N); end if; end Check_Restriction_No_Use_Of_Attribute; @@ -356,7 +355,7 @@ package body Restrict is return; end if; - -- If nothing set, nothing to check. + -- If nothing set, nothing to check if not No_Use_Of_Pragma_Set then return; @@ -368,8 +367,7 @@ package body Restrict is Error_Msg_Node_1 := Id; Error_Msg_Warn := No_Use_Of_Pragma_Warning (P_Id); Error_Msg_N - (" &`#", Id); end if; end Check_Restriction_No_Use_Of_Pragma; @@ -381,6 +379,10 @@ package body Restrict is function Chars_Is (E : Entity_Id; S : String) return Boolean; -- Return True iff Chars (E) matches S (given in lower case) + -------------- + -- Chars_Is -- + -------------- + function Chars_Is (E : Entity_Id; S : String) return Boolean is Nam : constant Name_Id := Chars (E); begin diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index 6da0cae..b01ffe4 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -253,12 +253,12 @@ package Restrict is -- being ignored here. procedure Check_Restriction_No_Use_Of_Attribute (N : Node_Id); - -- N is the node of an attribute definition clause. An error message + -- N is the node of an attribute definition clause. An error message -- (warning) will be issued if a restriction (warning) was previously set -- for this attribute using Set_No_Use_Of_Attribute. - procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id); - -- N is the node of a pragma. An error message (warning) will be issued + procedure Check_Restriction_No_Use_Of_Pragma (N : Node_Id); + -- N is the node of a pragma. An error message (warning) will be issued -- if a restriction (warning) was previously set for this pragma using -- Set_No_Use_Of_Pragma. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index b8ecf39..7ac29bb 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -414,8 +414,7 @@ package body Sem_Ch4 is Check_Restriction (No_Allocators, N); -- Processing for No_Standard_Allocators_After_Elaboration, loop to - -- look at enclosing context, checking task case and main subprogram - -- case. + -- look at enclosing context, checking task/main subprogram case. C := N; P := Parent (C); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 710983f..fe640d5 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -3339,14 +3339,11 @@ package body Sem_Elab is if Nkind (Item) = N_Pragma and then Pragma_Name (Item) = Name_Elaborate_All then - -- Return if some previous error on the pragma itself - -- The pragma may be unanalyzed, because of a previous error, - -- or if it is the context of a subunit, inherited by its - -- parent. + -- Return if some previous error on the pragma itself. The + -- pragma may be unanalyzed, because of a previous error, or + -- if it is the context of a subunit, inherited by its parent. - if Error_Posted (Item) - or else not Analyzed (Item) - then + if Error_Posted (Item) or else not Analyzed (Item) then return; end if; -- 2.7.4