[multiple changes]

2013-10-10  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Pragma): Provide a
	more precise error message when pragma Refined_Pre applies to
	an expression function that is not a completion.

2013-10-10  Thomas Quinot  <quinot@adacore.com>

	* sem_attr.adb (Analyse_Attribute, case
	Attribute_Scalar_Storage_Order): a 'Scalar_Storage_Order attribute
	reference for a generic type is permitted in GNAT runtime mode.
	* a-sequio.adb (Read, Write): Use the endianness of the actual
	type to encode length information written to the file.

From-SVN: r203356

4 files changed, 94 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index be5c547..df6f31c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2013-10-10  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragma): Provide a
+	more precise error message when pragma Refined_Pre applies to
+	an expression function that is not a completion.
+
+2013-10-10  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_attr.adb (Analyse_Attribute, case
+	Attribute_Scalar_Storage_Order): a 'Scalar_Storage_Order attribute
+	reference for a generic type is permitted in GNAT runtime mode.
+	* a-sequio.adb (Read, Write): Use the endianness of the actual
+	type to encode length information written to the file.
+
 2013-10-10  Ed Schonberg  <schonberg@adacore.com>
 
 	* par-ch13.adb (Aspect_Specifications_Present)): In earlier than
diff --git a/gcc/ada/a-sequio.adb b/gcc/ada/a-sequio.adb
index 397a778..b9442e9 100644
--- a/gcc/ada/a-sequio.adb
+++ b/gcc/ada/a-sequio.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- --
@@ -34,13 +34,14 @@
 --  in System.File_IO (for common file functions), or in System.Sequential_IO
 --  (for specialized Sequential_IO functions)
 
-with Interfaces.C_Streams; use Interfaces.C_Streams;
+with Ada.Unchecked_Conversion;
 with System;
 with System.CRTL;
 with System.File_Control_Block;
 with System.File_IO;
 with System.Storage_Elements;
-with Ada.Unchecked_Conversion;
+with Interfaces.C_Streams; use Interfaces.C_Streams;
+with GNAT.Byte_Swapping;
 
 package body Ada.Sequential_IO is
 
@@ -57,8 +58,26 @@ package body Ada.Sequential_IO is
    function To_FCB is new Ada.Unchecked_Conversion (File_Mode, FCB.File_Mode);
    function To_SIO is new Ada.Unchecked_Conversion (FCB.File_Mode, File_Mode);
 
+   use type System.Bit_Order;
    use type System.CRTL.size_t;
 
+   procedure Byte_Swap (Siz : in out size_t);
+   --  Byte swap Siz
+
+   ---------------
+   -- Byte_Swap --
+   ---------------
+
+   procedure Byte_Swap (Siz : in out size_t) is
+      use GNAT.Byte_Swapping;
+   begin
+      case Siz'Size is
+         when 32     => Swap4 (Siz'Address);
+         when 64     => Swap8 (Siz'Address);
+         when others => raise Program_Error;
+      end case;
+   end Byte_Swap;
+
    -----------
    -- Close --
    -----------
@@ -170,6 +189,10 @@ package body Ada.Sequential_IO is
          FIO.Read_Buf
            (AP (File), Rsiz'Address, size_t'Size / System.Storage_Unit);
 
+         if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then
+            Byte_Swap (Rsiz);
+         end if;
+
          --  For a type with discriminants, we have to read into a temporary
          --  buffer if Item is constrained, to check that the discriminants
          --  are correct.
@@ -252,6 +275,10 @@ package body Ada.Sequential_IO is
 
    procedure Write (File : File_Type; Item : Element_Type) is
       Siz : constant size_t := (Item'Size + SU - 1) / SU;
+      --  Size to be written, in native representation
+
+      Swapped_Siz : size_t := Siz;
+      --  Same, possibly byte swapped to account for Element_Type endianness
 
    begin
       FIO.Check_Write_Status (AP (File));
@@ -261,8 +288,12 @@ package body Ada.Sequential_IO is
       if not Element_Type'Definite
         or else Element_Type'Has_Discriminants
       then
+         if Element_Type'Scalar_Storage_Order /= System.Default_Bit_Order then
+            Byte_Swap (Swapped_Siz);
+         end if;
+
          FIO.Write_Buf
-           (AP (File), Siz'Address, size_t'Size / System.Storage_Unit);
+           (AP (File), Swapped_Siz'Address, size_t'Size / System.Storage_Unit);
       end if;
 
       FIO.Write_Buf (AP (File), Item'Address, Siz);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a46e057..bc5139f 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -5040,21 +5040,41 @@ package body Sem_Attr is
       --------------------------
 
       when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
+      declare
+         Ent : Entity_Id := Empty;
       begin
          Check_E0;
          Check_Type;
 
-         if not Is_Record_Type (P_Type) or else Is_Array_Type (P_Type) then
-            Error_Attr_P
-              ("prefix of % attribute must be record or array type");
-         end if;
+         if not (Is_Record_Type (P_Type) or else Is_Array_Type (P_Type)) then
+
+            --  In GNAT mode, the attribute applies to generic types as well
+            --  as composite types, and for non-composite types always returns
+            --  the default bit order for the target.
+
+            if not (GNAT_Mode and then Is_Generic_Type (P_Type))
+                  and then not In_Instance
+            then
+               Error_Attr_P
+                 ("prefix of % attribute must be record or array type");
+
+            elsif not Is_Generic_Type (P_Type) then
+               if Bytes_Big_Endian then
+                  Ent := RTE (RE_High_Order_First);
+               else
+                  Ent := RTE (RE_Low_Order_First);
+               end if;
+            end if;
+
+         elsif Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then
+            Ent := RTE (RE_High_Order_First);
 
-         if Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then
-            Rewrite (N,
-              New_Occurrence_Of (RTE (RE_High_Order_First), Loc));
          else
-            Rewrite (N,
-              New_Occurrence_Of (RTE (RE_Low_Order_First), Loc));
+            Ent := RTE (RE_Low_Order_First);
+         end if;
+
+         if Present (Ent) then
+            Rewrite (N, New_Occurrence_Of (Ent, Loc));
          end if;
 
          Set_Etype (N, RTE (RE_Bit_Order));
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9d8f590..fa189aa 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -15964,17 +15964,28 @@ package body Sem_Prag is
                      Error_Msg_N ("pragma % duplicates pragma declared #", N);
                   end if;
 
-               --  Skip internally generated code
-
-               elsif not Comes_From_Source (Stmt) then
-                  null;
-
                --  The pragma applies to a subprogram body stub
 
                elsif Nkind (Stmt) = N_Subprogram_Body_Stub then
                   Body_Decl := Stmt;
                   exit;
 
+               --  The pragma applies to an expression function that does not
+               --  act as a completion of a previous function declaration.
+
+               elsif Nkind (Stmt) = N_Subprogram_Declaration
+                 and then Nkind (Original_Node (Stmt)) = N_Expression_Function
+                 and then not
+                   Has_Completion (Defining_Unit_Name (Specification (Stmt)))
+               then
+                  Error_Pragma ("pragma % cannot apply to a stand alone body");
+                  return;
+
+               --  Skip internally generated code
+
+               elsif not Comes_From_Source (Stmt) then
+                  null;
+
                --  The pragma does not apply to a legal construct, issue an
                --  error and stop the analysis.