[multiple changes]

2012-03-09  Vasiliy Fofanov  <fofanov@adacore.com>

	* a-direct.adb: Do not strip the trailing directory separator
	from path, as this is already done inside Normalize_Pathname;
	doing it again produces the wrong result on Windows for the
	drive's root dir (i.e. "X:\" becomes "X:").

2012-03-09  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
	sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
	Add Attribute_Scalar_Storage_Order.
	(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
	(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
	Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
	(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
	for Scalar_Storage_Order.
	(Freeze): If Scalar_Storage_Order is specified, check that it
	is compatible with Bit_Order.

From-SVN: r185142

9 files changed, 140 insertions, 33 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fdb14dd..90f87dd 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2012-03-09  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* a-direct.adb: Do not strip the trailing directory separator
+	from path, as this is already done inside Normalize_Pathname;
+	doing it again produces the wrong result on Windows for the
+	drive's root dir (i.e. "X:\" becomes "X:").
+
+2012-03-09  Thomas Quinot  <quinot@adacore.com>
+
+	* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
+	sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
+	Add Attribute_Scalar_Storage_Order.
+	(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
+	(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
+	Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
+	(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
+	for Scalar_Storage_Order.
+	(Freeze): If Scalar_Storage_Order is specified, check that it
+	is compatible with Bit_Order.
+
 2012-03-09  Robert Dewar  <dewar@adacore.com>
 
 	* s-osinte-linux.ads, sem_util.adb, s-taprop-linux.adb, exp_ch4.adb,
diff --git a/gcc/ada/a-direct.adb b/gcc/ada/a-direct.adb
index e27bb3f..88e1d72 100644
--- a/gcc/ada/a-direct.adb
+++ b/gcc/ada/a-direct.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2012, 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- --
@@ -514,18 +514,10 @@ package body Ada.Directories is
    begin
       Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
 
-      declare
-         --  We need to resolve links because of A.16(47), since we must not
-         --  return alternative names for files
-         Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len));
+      --  We need to resolve links because of A.16(47), since we must not
+      --  return alternative names for files
+      return Normalize_Pathname (Buffer (1 .. Path_Len));
 
-      begin
-         if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
-            return Cur (1 .. Cur'Last - 1);
-         else
-            return Cur;
-         end if;
-      end;
    end Current_Directory;
 
    ----------------------
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 89af1d9..51f468c 100755
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -278,6 +278,7 @@ package body Aspects is
     Aspect_Pure_12                      => Aspect_Pure_12,
     Aspect_Remote_Call_Interface        => Aspect_Remote_Call_Interface,
     Aspect_Remote_Types                 => Aspect_Remote_Types,
+    Aspect_Scalar_Storage_Order         => Aspect_Scalar_Storage_Order,
     Aspect_Shared_Passive               => Aspect_Shared_Passive,
     Aspect_Universal_Data               => Aspect_Universal_Data,
     Aspect_Input                        => Aspect_Input,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index 3c28af8..84548a9 100755
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -74,6 +74,7 @@ package Aspects is
       Aspect_Predicate,                     -- GNAT
       Aspect_Priority,
       Aspect_Read,
+      Aspect_Scalar_Storage_Order,          -- GNAT
       Aspect_Simple_Storage_Pool,           -- GNAT
       Aspect_Size,
       Aspect_Small,
@@ -188,6 +189,7 @@ package Aspects is
                              Aspect_Pure_Function            => True,
                              Aspect_Remote_Access_Type       => True,
                              Aspect_Shared                   => True,
+                             Aspect_Scalar_Storage_Order     => True,
                              Aspect_Simple_Storage_Pool      => True,
                              Aspect_Simple_Storage_Pool_Type => True,
                              Aspect_Suppress_Debug_Info      => True,
@@ -281,6 +283,7 @@ package Aspects is
                         Aspect_Predicate               => Expression,
                         Aspect_Priority                => Expression,
                         Aspect_Read                    => Name,
+                        Aspect_Scalar_Storage_Order    => Expression,
                         Aspect_Simple_Storage_Pool     => Name,
                         Aspect_Size                    => Expression,
                         Aspect_Small                   => Expression,
@@ -367,6 +370,7 @@ package Aspects is
      Aspect_Remote_Access_Type           => Name_Remote_Access_Type,
      Aspect_Remote_Call_Interface        => Name_Remote_Call_Interface,
      Aspect_Remote_Types                 => Name_Remote_Types,
+     Aspect_Scalar_Storage_Order         => Name_Scalar_Storage_Order,
      Aspect_Shared                       => Name_Shared,
      Aspect_Shared_Passive               => Name_Shared_Passive,
      Aspect_Simple_Storage_Pool          => Name_Simple_Storage_Pool,
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 7621ff7..4f67ef9 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -5672,7 +5672,8 @@ package body Exp_Attr is
            Attribute_Definite                     |
            Attribute_Null_Parameter               |
            Attribute_Passed_By_Reference          |
-           Attribute_Pool_Address                 =>
+           Attribute_Pool_Address                 |
+           Attribute_Scalar_Storage_Order         =>
          null;
 
       --  The following attributes are also handled by the back end, but return
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 15bd6e0..51e87ac 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2129,6 +2129,28 @@ package body Freeze is
             Next_Entity (Comp);
          end loop;
 
+         --  Check compatibility of Scalar_Storage_Order with Bit_Order, if the
+         --  former is specified.
+
+         ADC := Get_Attribute_Definition_Clause
+                  (Rec, Attribute_Scalar_Storage_Order);
+
+         if Present (ADC)
+              and then
+            Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
+         then
+            if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
+               Error_Msg_N
+                 ("Scalar_Storage_Order High_Order_First is inconsistent with"
+                  & " Bit_Order", ADC);
+            else
+               Error_Msg_N
+                 ("Scalar_Storage_Order Low_Order_First is inconsistent with"
+                  & " Bit_Order", ADC);
+
+            end if;
+         end if;
+
          --  Deal with Bit_Order aspect specifying a non-default bit order
 
          if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index a2b33d8..3df4822 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4442,6 +4442,35 @@ package body Sem_Attr is
          Check_Object_Reference (E1);
          Set_Etype (N, Standard_Boolean);
 
+      --------------------------
+      -- Scalar_Storage_Order --
+      --------------------------
+
+      when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
+      begin
+         Check_E0;
+         Check_Type;
+
+         if not Is_Record_Type (P_Type) then
+            Error_Attr_P ("prefix of % attribute must be record type");
+         end if;
+
+         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));
+         end if;
+
+         Set_Etype (N, RTE (RE_Bit_Order));
+         Resolve (N);
+
+         --  Reset incorrect indication of staticness
+
+         Set_Is_Static_Expression (N, False);
+      end Scalar_Storage_Order;
+
       -----------
       -- Scale --
       -----------
@@ -7963,6 +7992,7 @@ package body Sem_Attr is
            Attribute_Priority                   |
            Attribute_Read                       |
            Attribute_Result                     |
+           Attribute_Scalar_Storage_Order       |
            Attribute_Simple_Storage_Pool        |
            Attribute_Storage_Pool               |
            Attribute_Storage_Size               |
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9e552ec..2a92558 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1064,24 +1064,25 @@ package body Sem_Ch13 is
 
                --  Aspects corresponding to attribute definition clauses
 
-               when Aspect_Address             |
-                    Aspect_Alignment           |
-                    Aspect_Bit_Order           |
-                    Aspect_Component_Size      |
-                    Aspect_External_Tag        |
-                    Aspect_Input               |
-                    Aspect_Machine_Radix       |
-                    Aspect_Object_Size         |
-                    Aspect_Output              |
-                    Aspect_Read                |
-                    Aspect_Size                |
-                    Aspect_Small               |
-                    Aspect_Simple_Storage_Pool |
-                    Aspect_Storage_Pool        |
-                    Aspect_Storage_Size        |
-                    Aspect_Stream_Size         |
-                    Aspect_Value_Size          |
-                    Aspect_Write               =>
+               when Aspect_Address              |
+                    Aspect_Alignment            |
+                    Aspect_Bit_Order            |
+                    Aspect_Component_Size       |
+                    Aspect_External_Tag         |
+                    Aspect_Input                |
+                    Aspect_Machine_Radix        |
+                    Aspect_Object_Size          |
+                    Aspect_Output               |
+                    Aspect_Read                 |
+                    Aspect_Scalar_Storage_Order |
+                    Aspect_Size                 |
+                    Aspect_Small                |
+                    Aspect_Simple_Storage_Pool  |
+                    Aspect_Storage_Pool         |
+                    Aspect_Storage_Size         |
+                    Aspect_Stream_Size          |
+                    Aspect_Value_Size           |
+                    Aspect_Write                =>
 
                   --  Construct the attribute definition clause
 
@@ -2989,6 +2990,40 @@ package body Sem_Ch13 is
             Analyze_Stream_TSS_Definition (TSS_Stream_Read);
             Set_Has_Specified_Stream_Read (Ent);
 
+         --------------------------
+         -- Scalar_Storage_Order --
+         --------------------------
+
+         --  Scalar_Storage_Order attribute definition clause
+
+         when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : declare
+         begin
+            if not Is_Record_Type (U_Ent) then
+               Error_Msg_N
+                 ("Scalar_Storage_Order can only be defined for record type",
+                  Nam);
+
+            elsif Duplicate_Clause then
+               null;
+
+            else
+               Analyze_And_Resolve (Expr, RTE (RE_Bit_Order));
+
+               if Etype (Expr) = Any_Type then
+                  return;
+
+               elsif not Is_Static_Expression (Expr) then
+                  Flag_Non_Static_Expr
+                    ("Scalar_Storage_Order requires static expression!", Expr);
+
+               else
+                  if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
+                     Set_Reverse_Storage_Order (U_Ent, True);
+                  end if;
+               end if;
+            end if;
+         end Scalar_Storage_Order;
+
          ----------
          -- Size --
          ----------
@@ -6147,7 +6182,7 @@ package body Sem_Ch13 is
          when Aspect_Address =>
             T := RTE (RE_Address);
 
-         when Aspect_Bit_Order =>
+         when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
             T := RTE (RE_Bit_Order);
 
          when Aspect_CPU =>
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index cce4608..26cb3d9 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -120,7 +120,7 @@ package Snames is
    Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
    Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
 
-   --  Note: the following table is read by the utility program XSNAMES and
+   --  Note: the following table is read by the utility program XSNAMES, and
    --  its format should not be changed without coordinating with this program.
 
    N : constant Name_Id := First_Name_Id + 256;
@@ -826,6 +826,7 @@ package Snames is
    Name_Safe_Last                      : constant Name_Id := N + $;
    Name_Safe_Small                     : constant Name_Id := N + $; -- Ada 83
    Name_Same_Storage                   : constant Name_Id := N + $; -- Ada 12
+   Name_Scalar_Storage_Order           : constant Name_Id := N + $; -- GNAT
    Name_Scale                          : constant Name_Id := N + $;
    Name_Scaling                        : constant Name_Id := N + $;
    Name_Signed_Zeros                   : constant Name_Id := N + $;
@@ -1387,6 +1388,7 @@ package Snames is
       Attribute_Safe_Last,
       Attribute_Safe_Small,
       Attribute_Same_Storage,
+      Attribute_Scalar_Storage_Order,
       Attribute_Scale,
       Attribute_Scaling,
       Attribute_Signed_Zeros,