[multiple changes]

2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma, (Check_Mode_Restriction_In_Function):
	Correct error message format.

2013-04-12  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb: Minor reformatting.

2013-04-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_elab.adb (Within_Elaborate_All): Do not examine a context
	item that has not been analyzed, because the unit may have errors,
	or the context item may come from a proper unit inserted at the
	point of a stub and not analyzed yet.

2013-04-12  Thomas Quinot  <quinot@adacore.com>

	* gnat1drv.adb, repinfo.adb, repinfo.ads (Repinfo.List_Array_Info,
	List_Record_Info): Also include scalar storage order information in
	output.

2013-04-12  Yannick Moy  <moy@adacore.com>

	* sem_ch6.adb (Process_Contract_Cases): Update code to apply to
	Contract_Cases instead of Contract_Case pragma.

From-SVN: r197906

8 files changed, 178 insertions, 86 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0f68e47..0871311 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,30 @@
+2013-04-12  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma, (Check_Mode_Restriction_In_Function):
+	Correct error message format.
+
+2013-04-12  Robert Dewar  <dewar@adacore.com>
+
+	* sem_attr.adb: Minor reformatting.
+
+2013-04-12  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_elab.adb (Within_Elaborate_All): Do not examine a context
+	item that has not been analyzed, because the unit may have errors,
+	or the context item may come from a proper unit inserted at the
+	point of a stub and not analyzed yet.
+
+2013-04-12  Thomas Quinot  <quinot@adacore.com>
+
+	* gnat1drv.adb, repinfo.adb, repinfo.ads (Repinfo.List_Array_Info,
+	List_Record_Info): Also include scalar storage order information in
+	output.
+
+2013-04-12  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch6.adb (Process_Contract_Cases): Update code to apply to
+	Contract_Cases instead of Contract_Case pragma.
+
 2013-04-12  Robert Dewar  <dewar@adacore.com>
 
 	* a-cfdlli.ads, g-socket.adb, s-fileio.adb: Minor reformatting.
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 47337aa07..b41e3dd 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -1259,7 +1259,7 @@ begin
 
       Errout.Finalize (Last_Call => True);
       Errout.Output_Messages;
-      List_Rep_Info;
+      List_Rep_Info (Ttypes.Bytes_Big_Endian);
       List_Inlining_Info;
 
       --  Only write the library if the backend did not generate any error
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index c3e6772..e800859 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2011, 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- --
@@ -29,22 +29,23 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Alloc;  use Alloc;
-with Atree;  use Atree;
-with Casing; use Casing;
-with Debug;  use Debug;
-with Einfo;  use Einfo;
-with Lib;    use Lib;
-with Namet;  use Namet;
-with Opt;    use Opt;
-with Output; use Output;
-with Sinfo;  use Sinfo;
-with Sinput; use Sinput;
-with Snames; use Snames;
-with Stand;  use Stand;
-with Table;  use Table;
-with Uname;  use Uname;
-with Urealp; use Urealp;
+with Alloc;   use Alloc;
+with Atree;   use Atree;
+with Casing;  use Casing;
+with Debug;   use Debug;
+with Einfo;   use Einfo;
+with Lib;     use Lib;
+with Namet;   use Namet;
+with Opt;     use Opt;
+with Output;  use Output;
+with Sem_Aux; use Sem_Aux;
+with Sinfo;   use Sinfo;
+with Sinput;  use Sinput;
+with Snames;  use Snames;
+with Stand;   use Stand;
+with Table;   use Table;
+with Uname;   use Uname;
+with Urealp;  use Urealp;
 
 with Ada.Unchecked_Conversion;
 
@@ -133,7 +134,7 @@ package body Repinfo is
    --  Called before outputting anything for an entity. Ensures that
    --  a blank line precedes the output for a particular entity.
 
-   procedure List_Entities (Ent : Entity_Id);
+   procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
    --  This procedure lists the entities associated with the entity E, starting
    --  with the First_Entity and using the Next_Entity link. If a nested
    --  package is found, entities within the package are recursively processed.
@@ -142,7 +143,7 @@ package body Repinfo is
    --  List name of entity Ent in appropriate case. The name is listed with
    --  full qualification up to but not including the compilation unit name.
 
-   procedure List_Array_Info (Ent : Entity_Id);
+   procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
    --  List representation info for array type Ent
 
    procedure List_Mechanisms (Ent : Entity_Id);
@@ -152,9 +153,14 @@ package body Repinfo is
    procedure List_Object_Info (Ent : Entity_Id);
    --  List representation info for object Ent
 
-   procedure List_Record_Info (Ent : Entity_Id);
+   procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean);
    --  List representation info for record type Ent
 
+   procedure List_Scalar_Storage_Order
+     (Ent              : Entity_Id;
+      Bytes_Big_Endian : Boolean);
+   --  List scalar storage order information for record or array type Ent
+
    procedure List_Type_Info (Ent : Entity_Id);
    --  List type info for type Ent
 
@@ -286,7 +292,7 @@ package body Repinfo is
    -- List_Array_Info --
    ----------------------
 
-   procedure List_Array_Info (Ent : Entity_Id) is
+   procedure List_Array_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
    begin
       List_Type_Info (Ent);
       Write_Str ("for ");
@@ -294,13 +300,15 @@ package body Repinfo is
       Write_Str ("'Component_Size use ");
       Write_Val (Component_Size (Ent));
       Write_Line (";");
+
+      List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
    end List_Array_Info;
 
    -------------------
    -- List_Entities --
    -------------------
 
-   procedure List_Entities (Ent : Entity_Id) is
+   procedure List_Entities (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
       Body_E : Entity_Id;
       E      : Entity_Id;
 
@@ -379,12 +387,12 @@ package body Repinfo is
 
                elsif Is_Record_Type (E) then
                   if List_Representation_Info >= 1 then
-                     List_Record_Info (E);
+                     List_Record_Info (E, Bytes_Big_Endian);
                   end if;
 
                elsif Is_Array_Type (E) then
                   if List_Representation_Info >= 1 then
-                     List_Array_Info (E);
+                     List_Array_Info (E, Bytes_Big_Endian);
                   end if;
 
                elsif Is_Type (E) then
@@ -411,7 +419,7 @@ package body Repinfo is
 
                if Ekind (E) = E_Package then
                   if No (Renamed_Object (E)) then
-                     List_Entities (E);
+                     List_Entities (E, Bytes_Big_Endian);
                   end if;
 
                --  Recurse into bodies
@@ -428,12 +436,12 @@ package body Repinfo is
                        or else
                      Ekind (E) = E_Protected_Body
                then
-                  List_Entities (E);
+                  List_Entities (E, Bytes_Big_Endian);
 
                --  Recurse into blocks
 
                elsif Ekind (E) = E_Block then
-                  List_Entities (E);
+                  List_Entities (E, Bytes_Big_Endian);
                end if;
             end if;
 
@@ -461,7 +469,7 @@ package body Repinfo is
                     and then
                       Nkind (Parent (Find_Declaration (Body_E))) /= N_Subunit
                   then
-                     List_Entities (Body_E);
+                     List_Entities (Body_E, Bytes_Big_Endian);
                   end if;
                end if;
 
@@ -779,7 +787,7 @@ package body Repinfo is
    -- List_Record_Info --
    ----------------------
 
-   procedure List_Record_Info (Ent : Entity_Id) is
+   procedure List_Record_Info (Ent : Entity_Id; Bytes_Big_Endian : Boolean) is
       Comp  : Entity_Id;
       Cfbit : Uint;
       Sunit : Uint;
@@ -963,13 +971,15 @@ package body Repinfo is
       end loop;
 
       Write_Line ("end record;");
+
+      List_Scalar_Storage_Order (Ent, Bytes_Big_Endian);
    end List_Record_Info;
 
    -------------------
    -- List_Rep_Info --
    -------------------
 
-   procedure List_Rep_Info is
+   procedure List_Rep_Info (Bytes_Big_Endian : Boolean) is
       Col : Nat;
 
    begin
@@ -994,7 +1004,7 @@ package body Repinfo is
                   end loop;
 
                   Write_Eol;
-                  List_Entities (Cunit_Entity (U));
+                  List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
 
                --  List representation information to file
 
@@ -1002,7 +1012,7 @@ package body Repinfo is
                   Create_Repinfo_File_Access.all
                     (Get_Name_String (File_Name (Source_Index (U))));
                   Set_Special_Output (Write_Info_Line'Access);
-                  List_Entities (Cunit_Entity (U));
+                  List_Entities (Cunit_Entity (U), Bytes_Big_Endian);
                   Set_Special_Output (null);
                   Close_Repinfo_File_Access.all;
                end if;
@@ -1011,6 +1021,49 @@ package body Repinfo is
       end if;
    end List_Rep_Info;
 
+   -------------------------------
+   -- List_Scalar_Storage_Order --
+   -------------------------------
+
+   procedure List_Scalar_Storage_Order
+     (Ent              : Entity_Id;
+      Bytes_Big_Endian : Boolean)
+   is
+      procedure List_Attr (Attr_Name : String);
+      --  Show attribute definition clause for Attr_Name
+
+      ---------------
+      -- List_Attr --
+      ---------------
+
+      procedure List_Attr (Attr_Name : String) is
+      begin
+         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;
+
+   --  Start of processing for List_Scalar_Storage_Order
+
+   begin
+      if Has_Rep_Item (Ent, Name_Scalar_Storage_Order) then
+
+         --  For a record type with explicitly specified scalar storage order,
+         --  also display explicit Bit_Order.
+
+         if Is_Record_Type (Ent) then
+            List_Attr ("Bit_Order");
+         end if;
+         List_Attr ("Scalar_Storage_Order");
+      end if;
+   end List_Scalar_Storage_Order;
+
    --------------------
    -- List_Type_Info --
    --------------------
diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads
index 6527699..99fccc3 100644
--- a/gcc/ada/repinfo.ads
+++ b/gcc/ada/repinfo.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2009, 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- --
@@ -283,8 +283,9 @@ package Repinfo is
    -- Compiler Interface --
    ------------------------
 
-   procedure List_Rep_Info;
-   --  Procedure to list representation information
+   procedure List_Rep_Info (Bytes_Big_Endian : Boolean);
+   --  Procedure to list representation information. Bytes_Big_Endian is the
+   --  value from Ttypes (Repinfo cannot have a dependency on Ttypes).
 
    procedure Tree_Write;
    --  Writes out internal tables to current tree file using the relevant
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 8880012..11667cd 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4314,8 +4314,8 @@ package body Sem_Attr is
                      Arg := Parent (Arg);
                   end loop;
 
-                  --  At this point, Parent (Arg) should be a
-                  --  N_Component_Association. Attribute Old is only allowed in
+                  --  At this point, Parent (Arg) should be a component
+                  --  association. Attribute Result is only allowed in
                   --  the expression part of this association.
 
                   if Nkind (Parent (Arg)) /= N_Component_Association
@@ -4731,9 +4731,9 @@ package body Sem_Attr is
                      Arg := Parent (Arg);
                   end loop;
 
-                  --  At this point, Parent (Arg) should be a
-                  --  N_Component_Association. Attribute Result is only
-                  --  allowed in the expression part of this association.
+                  --  At this point, Parent (Arg) should be a component
+                  --  association. Attribute Result is only allowed in
+                  --  the expression part of this association.
 
                   if Nkind (Parent (Arg)) /= N_Component_Association
                     or else Arg /= Expression (Parent (Arg))
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index e57d95f..c3e7d433 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7064,8 +7064,8 @@ package body Sem_Ch6 is
       --  Last non-trivial postcondition on the subprogram, or else Empty if
       --  either no non-trivial postcondition or only inherited postconditions.
 
-      Last_Contract_Case : Node_Id := Empty;
-      --  Last non-trivial contract-case on the subprogram, or else Empty
+      Last_Contract_Cases : Node_Id := Empty;
+      --  Last non-trivial contract-cases on the subprogram, or else Empty
 
       Attribute_Result_Mentioned : Boolean := False;
       --  Whether attribute 'Result is mentioned in a non-trivial postcondition
@@ -7204,8 +7204,10 @@ package body Sem_Ch6 is
       ----------------------------
 
       procedure Process_Contract_Cases (Spec : Node_Id) is
-         Prag : Node_Id;
-         Arg  : Node_Id;
+         Prag       : Node_Id;
+         Aggr       : Node_Id;
+         Conseq     : Node_Id;
+         Post_Case  : Node_Id;
 
          Ignored : Traverse_Final_Result;
          pragma Unreferenced (Ignored);
@@ -7213,42 +7215,47 @@ package body Sem_Ch6 is
       begin
          Prag := Spec_CTC_List (Contract (Spec));
          loop
-            --  Retrieve the Ensures component of the contract-case, if any
+            if Pragma_Name (Prag) = Name_Contract_Cases then
 
-            Arg := Get_Ensures_From_CTC_Pragma (Prag);
+               Aggr := Expression (First
+                         (Pragma_Argument_Associations (Prag)));
 
-            --  Ignore trivial contract-case when Ensures component is "True"
-            --  or "False".
+               Post_Case := First (Component_Associations (Aggr));
+               while Present (Post_Case) loop
+                  Conseq := Expression (Post_Case);
 
-            if Pragma_Name (Prag) = Name_Contract_Case
-              and then not Is_Trivial_Post_Or_Ensures (Expression (Arg))
-            then
-               --  Since contract-cases are listed in reverse order, the first
-               --  contract-case in the list is the last in the source.
+                  --  Ignore trivial contract-case when consequence is "True"
+                  --  or "False".
 
-               if No (Last_Contract_Case) then
-                  Last_Contract_Case := Prag;
-               end if;
+                  if not Is_Trivial_Post_Or_Ensures (Conseq) then
 
-               --  For functions, look for presence of 'Result in Ensures
+                     Last_Contract_Cases := Prag;
 
-               if Ekind_In (Spec_Id, E_Function, E_Generic_Function) then
-                  Ignored := Find_Attribute_Result (Arg);
-               end if;
+                     --  For functions, look for presence of 'Result in
+                     --  consequence expression.
 
-               --  For each individual contract-case, look for presence
-               --  of an expression that could be evaluated differently
-               --  in post-state.
+                     if Ekind_In (Spec_Id, E_Function, E_Generic_Function) then
+                        Ignored := Find_Attribute_Result (Conseq);
+                     end if;
 
-               Post_State_Mentioned := False;
-               Ignored := Find_Post_State (Arg);
+                     --  For each individual case, look for presence of an
+                     --  expression that could be evaluated differently in
+                     --  post-state.
 
-               if Post_State_Mentioned then
-                  No_Warning_On_Some_Postcondition := True;
-               else
-                  Error_Msg_N
-                    ("`Ensures` component refers only to pre-state??", Prag);
-               end if;
+                     Post_State_Mentioned := False;
+                     Ignored := Find_Post_State (Conseq);
+
+                     if Post_State_Mentioned then
+                        No_Warning_On_Some_Postcondition := True;
+                     else
+                        Error_Msg_N
+                          ("contract case refers only to pre-state?T?",
+                           Conseq);
+                     end if;
+                  end if;
+
+                  Next (Post_Case);
+               end loop;
             end if;
 
             Prag := Next_Pragma (Prag);
@@ -7304,7 +7311,7 @@ package body Sem_Ch6 is
                      No_Warning_On_Some_Postcondition := True;
                   else
                      Error_Msg_N
-                       ("postcondition refers only to pre-state??", Prag);
+                       ("postcondition refers only to pre-state?T?", Prag);
                   end if;
                end if;
             end if;
@@ -7352,12 +7359,12 @@ package body Sem_Ch6 is
 
       if Ekind_In (Spec_Id, E_Function, E_Generic_Function)
         and then (Present (Last_Postcondition)
-                   or else Present (Last_Contract_Case))
+                   or else Present (Last_Contract_Cases))
         and then not Attribute_Result_Mentioned
         and then No_Warning_On_Some_Postcondition
       then
          if Present (Last_Postcondition) then
-            if Present (Last_Contract_Case) then
+            if Present (Last_Contract_Cases) then
                Error_Msg_N
                  ("neither function postcondition nor "
                   & "contract cases mention result?T?", Last_Postcondition);
@@ -7369,7 +7376,7 @@ package body Sem_Ch6 is
             end if;
          else
             Error_Msg_N
-              ("contract cases do not mention result?T?", Last_Contract_Case);
+              ("contract cases do not mention result?T?", Last_Contract_Cases);
          end if;
       end if;
    end Check_Subprogram_Contract;
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 74cbdf1..881fdb1 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1997-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1997-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- --
@@ -3340,8 +3340,13 @@ package body Sem_Elab is
               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.
 
-               if Error_Posted (Item) then
+               if Error_Posted (Item)
+                 or else not Analyzed (Item)
+               then
                   return;
                end if;
 
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 230e44b..e4e9446 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6871,8 +6871,8 @@ package body Sem_Prag is
                --  declare additional states.
 
                if Null_Seen then
-                  Error_Msg_Name_1 := Chars (Pack_Id);
-                  Error_Msg_N ("package % has null abstract state", State);
+                  Error_Msg_NE
+                    ("package & has null abstract state", State, Pack_Id);
 
                --  Null states appear as internally generated entities
 
@@ -6885,9 +6885,9 @@ package body Sem_Prag is
                   --  non-null states.
 
                   if Non_Null_Seen then
-                     Error_Msg_Name_1 := Chars (Pack_Id);
-                     Error_Msg_N
-                       ("package % has non-null abstract state", State);
+                     Error_Msg_NE
+                       ("package & has non-null abstract state",
+                        State, Pack_Id);
                   end if;
 
                --  Simple state declaration
@@ -11364,9 +11364,8 @@ package body Sem_Prag is
                procedure Check_Mode_Restriction_In_Function (Mode : Node_Id) is
                begin
                   if Ekind (Subp_Id) = E_Function then
-                     Error_Msg_NE
-                       ("global mode & not applicable to functions",
-                        Mode, Mode);
+                     Error_Msg_N
+                       ("global mode & not applicable to functions", Mode);
                   end if;
                end Check_Mode_Restriction_In_Function;