aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-02-06 11:35:52 +0100
committerArnaud Charlet <charlet@gcc.gnu.org>2013-02-06 11:35:52 +0100
commitd7761b2d64f02ce7b9fd7c354c2f5b98805235c6 (patch)
treeeb7188a0eeffb5040590e4c4c719f34aa0054d7b /gcc/ada
parent6d840d998086aa54b0a43c45b7a323f0408bf308 (diff)
downloadgcc-d7761b2d64f02ce7b9fd7c354c2f5b98805235c6.zip
gcc-d7761b2d64f02ce7b9fd7c354c2f5b98805235c6.tar.gz
gcc-d7761b2d64f02ce7b9fd7c354c2f5b98805235c6.tar.bz2
[multiple changes]
2013-02-06 Robert Dewar <dewar@adacore.com> * sem_ch3.adb, sem_ch10.adb: Minor reformatting. * exp_disp.adb: Minor comment update. * comperr.ads, osint.ads, rtsfind.adb, sem_prag.adb: Minor addition of No_Return pragmas. 2013-02-06 Thomas Quinot <quinot@adacore.com> * targparm.ads, sem_ch13.adb (Support_Nondefault_SSO): New target parameter, defaulted to False for now, indicates targets where non-default scalar storage order may be specified. 2013-02-06 Thomas Quinot <quinot@adacore.com> * sprint.adb (Write_Itype): Treat E_Record_Subtype_With_Private same as E_Record_Subtype. Display E_Class_Wide_Subtype as subtype, not type. From-SVN: r195797
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog19
-rw-r--r--gcc/ada/comperr.ads3
-rw-r--r--gcc/ada/exp_ch6.adb4
-rw-r--r--gcc/ada/exp_disp.adb5
-rw-r--r--gcc/ada/osint.ads3
-rw-r--r--gcc/ada/rtsfind.adb3
-rw-r--r--gcc/ada/sem_ch10.adb9
-rw-r--r--gcc/ada/sem_ch13.adb12
-rw-r--r--gcc/ada/sem_ch3.adb14
-rw-r--r--gcc/ada/sem_prag.adb4
-rw-r--r--gcc/ada/sprint.adb4
-rw-r--r--gcc/ada/targparm.ads7
12 files changed, 64 insertions, 23 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccc6b85..d41a8d1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,22 @@
+2013-02-06 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb, sem_ch10.adb: Minor reformatting.
+ * exp_disp.adb: Minor comment update.
+ * comperr.ads, osint.ads, rtsfind.adb, sem_prag.adb: Minor addition of
+ No_Return pragmas.
+
+2013-02-06 Thomas Quinot <quinot@adacore.com>
+
+ * targparm.ads, sem_ch13.adb (Support_Nondefault_SSO): New target
+ parameter, defaulted to False for now, indicates targets where
+ non-default scalar storage order may be specified.
+
+2013-02-06 Thomas Quinot <quinot@adacore.com>
+
+ * sprint.adb (Write_Itype): Treat E_Record_Subtype_With_Private
+ same as E_Record_Subtype. Display E_Class_Wide_Subtype as
+ subtype, not type.
+
2013-02-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb (Complete_Private_Subtype): Inherit the
diff --git a/gcc/ada/comperr.ads b/gcc/ada/comperr.ads
index a45faf1..ba3cb6b 100644
--- a/gcc/ada/comperr.ads
+++ b/gcc/ada/comperr.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -33,6 +33,7 @@ package Comperr is
(X : String;
Code : Integer := 0;
Fallback_Loc : String := "");
+ pragma No_Return (Compiler_Abort);
-- Signals an internal compiler error. Never returns control. Depending on
-- processing may end up raising Unrecoverable_Error, or exiting directly.
-- The message output is a "bug box" containing the first string passed as
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index a2caf15..9288e84 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -4181,9 +4181,7 @@ package body Exp_Ch6 is
if Is_Entity_Name (N) and then Present (Entity (N)) then
E := Entity (N);
- if Is_Formal (E)
- and then Scope (E) = Subp
- then
+ if Is_Formal (E) and then Scope (E) = Subp then
A := Renamed_Object (E);
-- Rewrite the occurrence of the formal into an occurrence of
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 5b8ae17..bc4ab50 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -4132,6 +4132,9 @@ package body Exp_Disp is
-- Nb_Prim. If the tagged type has no primitives we add a dummy
-- slot whose address will be the tag of this type.
+ -- ???codepeer???
+ -- Nb_Prim cannot be zero here, so this test is wrong
+
if Nb_Prim = 0 then
New_Node := Make_Integer_Literal (Loc, 1);
else
diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads
index 48a7d8e..cbbcd92 100644
--- a/gcc/ada/osint.ads
+++ b/gcc/ada/osint.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -637,6 +637,7 @@ package Osint is
-- Set_Exit_Status as the last action of the program.
procedure OS_Exit_Through_Exception (Status : Integer);
+ pragma No_Return;
-- Set the Current_Exit_Status, then raise Types.Terminate_Program
type Exit_Code_Type is (
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index ac662f8..5327da5 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -148,6 +148,7 @@ package body Rtsfind is
-- value in RTU_Id.
procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id);
+ pragma No_Return (Load_Fail);
-- Internal procedure called if we can't successfully locate or process a
-- run-time unit. The parameters give information about the error message
-- to be given. S is a reason for failing to compile the file and U_Id is
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index e936838..a4241af 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -4741,11 +4741,10 @@ package body Sem_Ch10 is
-- compiling the body of the child unit.
if P = Cunit_Entity (Current_Sem_Unit)
- or else
- (Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
- and then P = Main_Unit_Entity
- and then
- Is_Ancestor_Unit (Cunit (Main_Unit), Cunit (Current_Sem_Unit)))
+ or else (Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body
+ and then P = Main_Unit_Entity
+ and then Is_Ancestor_Unit
+ (Cunit (Main_Unit), Cunit (Current_Sem_Unit)))
then
return;
end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 63c4d08..92df556 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -3622,9 +3622,17 @@ package body Sem_Ch13 is
Flag_Non_Static_Expr
("Scalar_Storage_Order requires static expression!", Expr);
- else
- if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
+ elsif (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
+
+ -- Here for the case of a non-default (i.e. non-confirming)
+ -- Scalar_Storage_Order attribute definition.
+
+ if Support_Nondefault_SSO_On_Target then
Set_Reverse_Storage_Order (Base_Type (U_Ent), True);
+ else
+ Error_Msg_N
+ ("non-default Scalar_Storage_Order "
+ & "not supported on target", Expr);
end if;
end if;
end if;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 224a3d9..130cba6 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -10255,21 +10255,23 @@ package body Sem_Ch3 is
Protected_Kind =>
Copy_Node (Priv, Full);
- Set_Has_Discriminants (Full, Has_Discriminants (Full_Base));
+ Set_Has_Discriminants
+ (Full, Has_Discriminants (Full_Base));
Set_Has_Unknown_Discriminants
- (Full, Has_Unknown_Discriminants (Full_Base));
- Set_First_Entity (Full, First_Entity (Full_Base));
- Set_Last_Entity (Full, Last_Entity (Full_Base));
+ (Full, Has_Unknown_Discriminants (Full_Base));
+ Set_First_Entity (Full, First_Entity (Full_Base));
+ Set_Last_Entity (Full, Last_Entity (Full_Base));
when others =>
Copy_Node (Full_Base, Full);
+
Set_Chars (Full, Chars (Priv));
Conditional_Delay (Full, Priv);
Set_Sloc (Full, Sloc (Priv));
end case;
- Set_Next_Entity (Full, Save_Next_Entity);
- Set_Homonym (Full, Save_Homonym);
+ Set_Next_Entity (Full, Save_Next_Entity);
+ Set_Homonym (Full, Save_Homonym);
Set_Associated_Node_For_Itype (Full, Related_Nod);
-- Set common attributes for all subtypes: kind, convention, etc.
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d72c7d7..1a34b34 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1924,6 +1924,7 @@ package body Sem_Prag is
procedure Check_Loop_Invariant_Variant_Placement is
procedure Placement_Error (Constr : Node_Id);
+ pragma No_Return (Placement_Error);
-- Node Constr denotes the last loop restricted construct before we
-- encountered an illegal relation between enclosing constructs. Emit
-- an error depending on what Constr was.
@@ -6049,6 +6050,7 @@ package body Sem_Prag is
S2 : constant String_Id := Strval (New_Name);
procedure Mismatch;
+ pragma No_Return (Mismatch);
-- Called if names do not match
--------------
@@ -6154,9 +6156,11 @@ package body Sem_Prag is
Mech_Name_Id : Name_Id;
procedure Bad_Class;
+ pragma No_Return (Bad_Class);
-- Signal bad descriptor class name
procedure Bad_Mechanism;
+ pragma No_Return (Bad_Mechanism);
-- Signal bad mechanism name
---------------
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 6aa045f..2717350 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -4145,7 +4145,7 @@ package body Sprint is
-- Record subtypes
- when E_Record_Subtype =>
+ when E_Record_Subtype | E_Record_Subtype_With_Private =>
Write_Header (False);
Write_Str ("record");
Indent_Begin;
@@ -4170,7 +4170,7 @@ package body Sprint is
when E_Class_Wide_Type |
E_Class_Wide_Subtype =>
- Write_Header;
+ Write_Header (Ekind (Typ) = E_Class_Wide_Type);
Write_Name_With_Col_Check (Chars (Etype (Typ)));
Write_Str ("'Class");
diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads
index 5869f0c..52a6ee4 100644
--- a/gcc/ada/targparm.ads
+++ b/gcc/ada/targparm.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2013, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -436,6 +436,11 @@ package Targparm is
-- the source program may not contain explicit 64-bit shifts. In addition,
-- the code generated for packed arrays will avoid the use of long shifts.
+ Support_Nondefault_SSO_On_Target : Boolean := False;
+ -- If True, the back end supports the non-default Scalar_Storage_Order
+ -- (i.e. allows non-confirming Scalar_Storage_Order attribute definition
+ -- clauses).
+
--------------------
-- Indirect Calls --
--------------------