diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-12 15:19:15 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2013-04-12 15:19:15 +0200 |
commit | 489c6e198e9e78f635878bdec992ce4d9fa807a2 (patch) | |
tree | dee6613608262bd3a26f31a89d7813d8d30eabc4 /gcc/ada | |
parent | a7e68e7fa76aa33eab48a30186abcb4d3b291322 (diff) | |
download | gcc-489c6e198e9e78f635878bdec992ce4d9fa807a2.zip gcc-489c6e198e9e78f635878bdec992ce4d9fa807a2.tar.gz gcc-489c6e198e9e78f635878bdec992ce4d9fa807a2.tar.bz2 |
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 13 | ||||
-rw-r--r-- | gcc/ada/checks.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch11.ads | 1 | ||||
-rw-r--r-- | gcc/ada/lib-xref.adb | 17 | ||||
-rw-r--r-- | gcc/ada/repinfo.adb | 3 | ||||
-rw-r--r-- | gcc/ada/restrict.adb | 24 | ||||
-rw-r--r-- | gcc/ada/restrict.ads | 6 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 3 | ||||
-rw-r--r-- | 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 <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> * 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 - ("<violation of restriction `No_Use_Of_Attribute '='> &`#", - N); + ("<violation of restriction `No_Use_Of_Attribute '='> &`#", 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 - ("<violation of restriction `No_Use_Of_Pragma '='> &`#", - Id); + ("<violation of restriction `No_Use_Of_Pragma '='> &`#", 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; |