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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@195797 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccc6b85..d41a8d1 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 --
    --------------------