aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-04-12 15:19:15 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-12 15:19:15 +0200
commit489c6e198e9e78f635878bdec992ce4d9fa807a2 (patch)
treedee6613608262bd3a26f31a89d7813d8d30eabc4 /gcc/ada
parenta7e68e7fa76aa33eab48a30186abcb4d3b291322 (diff)
downloadgcc-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/ChangeLog13
-rw-r--r--gcc/ada/checks.adb6
-rw-r--r--gcc/ada/exp_ch11.ads1
-rw-r--r--gcc/ada/lib-xref.adb17
-rw-r--r--gcc/ada/repinfo.adb3
-rw-r--r--gcc/ada/restrict.adb24
-rw-r--r--gcc/ada/restrict.ads6
-rw-r--r--gcc/ada/sem_ch4.adb3
-rw-r--r--gcc/ada/sem_elab.adb11
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;