[multiple changes]

2014-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Check_Non_Static_Context): Do not set
	Is_Machine_Number on a literal of a fixed-point type.

2014-10-23  Robert Dewar  <dewar@adacore.com>

	* mlib-prj.adb, sem_ch4.adb, exp_ch3.adb: Minor reformatting.

2014-10-23  Pierre-Marie Derodat  <derodat@adacore.com>

	* exp_dbug.ads: Update ___XA parallel type specification.

2014-10-23  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch3.adb (Copy_Array_Subtype_Attributes): Inherit the rep
	chain of the source type.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Minor
	reformatting of an error message.
	* sem_util.adb (Inherit_Rep_Item_Chain): Do not inherit a rep
	chain that has been inherited already.

From-SVN: r216588

9 files changed, 74 insertions, 93 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 353d0a5..7c3f5bb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
 2014-10-23  Ed Schonberg  <schonberg@adacore.com>
 
+	* sem_eval.adb (Check_Non_Static_Context): Do not set
+	Is_Machine_Number on a literal of a fixed-point type.
+
+2014-10-23  Robert Dewar  <dewar@adacore.com>
+
+	* mlib-prj.adb, sem_ch4.adb, exp_ch3.adb: Minor reformatting.
+
+2014-10-23  Pierre-Marie Derodat  <derodat@adacore.com>
+
+	* exp_dbug.ads: Update ___XA parallel type specification.
+
+2014-10-23  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch3.adb (Copy_Array_Subtype_Attributes): Inherit the rep
+	chain of the source type.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Minor
+	reformatting of an error message.
+	* sem_util.adb (Inherit_Rep_Item_Chain): Do not inherit a rep
+	chain that has been inherited already.
+
+2014-10-23  Ed Schonberg  <schonberg@adacore.com>
+
 	* sem_ch6.adb (Analyze_Expression_Function): Simplify analysis
 	in generic context, and generate body in this case as well,
 	to simplify ASIS traversals on the construct.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 1480c0f..2de1887 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5366,9 +5366,9 @@ package body Exp_Ch3 is
         and then Static_Dispatch_Tables
         and then Is_Library_Level_Entity (Def_Id)
         and then Is_Library_Level_Tagged_Type (Base_Typ)
-        and then (Ekind (Base_Typ) = E_Record_Type
-                   or else Ekind (Base_Typ) = E_Protected_Type
-                   or else Ekind (Base_Typ) = E_Task_Type)
+        and then Ekind_In (Base_Typ, E_Record_Type,
+                                     E_Protected_Type,
+                                     E_Task_Type)
         and then not Has_Dispatch_Table (Base_Typ)
       then
          declare
diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads
index eefc9c9..727be92 100644
--- a/gcc/ada/exp_dbug.ads
+++ b/gcc/ada/exp_dbug.ads
@@ -854,9 +854,8 @@ package Exp_Dbug is
       --  names of these types).
 
       --  To conserve space, we do not produce this type unless one of the
-      --  index types is either an enumeration type, has a variable upper
-      --  bound, has a lower bound different from the constant 1, is a biased
-      --  type, or is wider than "sizetype".
+      --  index types is either an enumeration type, has a variable lower or
+      --  upper bound or is a biased type.
 
       --  Given the full encoding of these types (see above description for
       --  the encoding of discrete types), this means that all necessary
diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb
index 236a636..ff84aba 100644
--- a/gcc/ada/mlib-prj.adb
+++ b/gcc/ada/mlib-prj.adb
@@ -2395,7 +2395,7 @@ package body MLib.Prj is
             --  because they are also needed for non Stand-Alone shared
             --  libraries.
 
-            --  Also ignore the shared libraries which are :
+            --  Also ignore the shared libraries which are:
 
             --  -lgnat-<version>  (7 + version'length chars)
             --  -lgnarl-<version> (8 + version'length chars)
@@ -2403,13 +2403,15 @@ package body MLib.Prj is
             if Next_Line (1 .. Nlast) /= "-static" and then
                Next_Line (1 .. Nlast) /= "-shared" and then
                Next_Line (1 .. Nlast) /= "-lgnarl" and then
-               Next_Line (1 .. Nlast) /= "-lgnat" and then
-               Next_Line
-                 (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
-                   Shared_Lib ("gnarl") and then
-               Next_Line
-                 (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
-                   Shared_Lib ("gnat")
+               Next_Line (1 .. Nlast) /= "-lgnat"
+              and then
+                Next_Line
+                  (1 .. Natural'Min (Nlast, 8 + Library_Version'Length)) /=
+                    Shared_Lib ("gnarl")
+              and then
+                Next_Line
+                  (1 .. Natural'Min (Nlast, 7 + Library_Version'Length)) /=
+                    Shared_Lib ("gnat")
             then
                if Next_Line (1) /= '-' then
 
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index c1c9eec..15e232b 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2701,7 +2701,7 @@ package body Sem_Ch13 is
                when Aspect_Default_Value =>
                   if not Is_Scalar_Type (E) then
                      Error_Msg_N
-                       ("aspect Default_Value must apply to a scalar_Type", N);
+                       ("aspect Default_Value must apply to a scalar type", N);
                   end if;
 
                   Aitem := Empty;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 27c2286..5993bdb 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8697,61 +8697,9 @@ package body Sem_Ch3 is
          Set_Has_Predicates (Derived_Type);
       end if;
 
-      --  The derived type inherits the representation clauses of the parent.
-      --  However, for a private type that is completed by a derivation, there
-      --  may be operation attributes that have been specified already (stream
-      --  attributes and External_Tag) and those must be provided. Finally, if
-      --  the partial view is a private extension, the representation items of
-      --  the parent have been inherited already, and should not be chained
-      --  twice to the derived type.
-
-      --  Historic note: The guard below used to check whether the parent type
-      --  is tagged. This is no longer needed because an untagged derived type
-      --  may carry rep items of its own as a result of certain SPARK pragmas.
-      --  With the old guard in place, the rep items of the derived type were
-      --  clobbered.
-
-      if Present (First_Rep_Item (Derived_Type)) then
-         declare
-            Par_Item  : constant Node_Id := First_Rep_Item (Parent_Type);
-            Inherited : Boolean := False;
-            Item      : Node_Id;
-            Last_Item : Node_Id;
-
-         begin
-            --  Inspect the rep item chain of the derived type and perform the
-            --  following two functions:
-            --    1) Determine whether the derived type already inherited the
-            --       rep items of the parent type.
-            --    2) Find the last rep item of the derived type
-
-            Item := First_Rep_Item (Derived_Type);
-            Last_Item := Item;
-            while Present (Item) loop
-               if Item = Par_Item then
-                  Inherited := True;
-                  exit;
-               end if;
-
-               Last_Item := Item;
-               Item := Next_Rep_Item (Item);
-            end loop;
+      --  The derived type inherits the representation clauses of the parent
 
-            --  Nothing to do if the derived type already inherited the rep
-            --  items from the parent type, otherwise append the parent rep
-            --  item chain to that of the derived type.
-
-            if not Inherited then
-               Set_Next_Rep_Item (Last_Item, Par_Item);
-            end if;
-         end;
-
-      --  Otherwise the derived type lacks rep items and directly inherits the
-      --  rep items of the parent type.
-
-      else
-         Set_First_Rep_Item (Derived_Type, First_Rep_Item (Parent_Type));
-      end if;
+      Inherit_Rep_Item_Chain (Derived_Type, Parent_Type);
 
       --  Propagate the attributes related to pragma Default_Initial_Condition
       --  from the parent type to the private extension. A derived type always
@@ -13396,17 +13344,17 @@ package body Sem_Ch3 is
    begin
       Set_Size_Info (T1, T2);
 
-      Set_First_Index          (T1, First_Index           (T2));
-      Set_Is_Aliased           (T1, Is_Aliased            (T2));
-      Set_Is_Volatile          (T1, Is_Volatile           (T2));
-      Set_Treat_As_Volatile    (T1, Treat_As_Volatile     (T2));
-      Set_Is_Constrained       (T1, Is_Constrained        (T2));
-      Set_Depends_On_Private   (T1, Has_Private_Component (T2));
-      Set_First_Rep_Item       (T1, First_Rep_Item        (T2));
-      Set_Convention           (T1, Convention            (T2));
-      Set_Is_Limited_Composite (T1, Is_Limited_Composite  (T2));
-      Set_Is_Private_Composite (T1, Is_Private_Composite  (T2));
-      Set_Packed_Array_Impl_Type    (T1, Packed_Array_Impl_Type     (T2));
+      Set_First_Index            (T1, First_Index            (T2));
+      Set_Is_Aliased             (T1, Is_Aliased             (T2));
+      Set_Is_Volatile            (T1, Is_Volatile            (T2));
+      Set_Treat_As_Volatile      (T1, Treat_As_Volatile      (T2));
+      Set_Is_Constrained         (T1, Is_Constrained         (T2));
+      Set_Depends_On_Private     (T1, Has_Private_Component  (T2));
+      Inherit_Rep_Item_Chain     (T1,                         T2);
+      Set_Convention             (T1, Convention             (T2));
+      Set_Is_Limited_Composite   (T1, Is_Limited_Composite   (T2));
+      Set_Is_Private_Composite   (T1, Is_Private_Composite   (T2));
+      Set_Packed_Array_Impl_Type (T1, Packed_Array_Impl_Type (T2));
    end Copy_Array_Subtype_Attributes;
 
    -----------------------------------
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 7914fe1..3f9fc98 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -7591,7 +7591,7 @@ package body Sem_Ch4 is
                  or else not Is_Variable (Obj)
                then
                   Error_Msg_NE
-                    ("actual for& must be a variable", Obj, Control);
+                    ("actual for & must be a variable", Obj, Control);
                end if;
             end if;
 
@@ -7602,9 +7602,8 @@ package body Sem_Ch4 is
 
             if not Is_Aliased_View (Obj) then
                Error_Msg_NE
-                 ("object in prefixed call to& must be aliased"
-                      & " (RM-2005 4.3.1 (13))",
-                 Prefix (First_Actual), Subprog);
+                 ("object in prefixed call to & must be aliased "
+                  & " (RM-2005 4.3.1 (13))", Prefix (First_Actual), Subprog);
             end if;
 
             Analyze (First_Actual);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 1922d5e..77eb48c 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -498,13 +498,15 @@ package body Sem_Eval is
             --  differences in rounding between static and non-static
             --  expressions. AI-100 specifies that the effect of such rounding
             --  is implementation dependent, and in GNAT we round to nearest
-            --  even to match the run-time behavior.
+            --  even to match the run-time behavior. Note that this applies
+            --  to floating point literals, not fixed points ones, even though
+            --  their compiler representation is also as a universal real.
 
             Set_Realval
               (N, Machine (Base_Type (T), Realval (N), Round_Even, N));
+            Set_Is_Machine_Number (N);
          end if;
 
-         Set_Is_Machine_Number (N);
       end if;
 
       --  Check for out of range universal integer. This is a non-static
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 09f8094..1f1128c 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -9296,25 +9296,34 @@ package body Sem_Util is
 
    procedure Inherit_Rep_Item_Chain (Typ : Entity_Id; From_Typ : Entity_Id) is
       From_Item : constant Node_Id := First_Rep_Item (From_Typ);
-      Item      : Node_Id;
+      Item      : Node_Id := Empty;
+      Last_Item : Node_Id := Empty;
 
    begin
-      --  Reach the end of the destination type's chain (if any). The traversal
-      --  ensures that we do not go past the last item.
+      --  Reach the end of the destination type's chain (if any) and capture
+      --  the last item.
 
       Item := First_Rep_Item (Typ);
-      while Present (Item) and then Present (Next_Rep_Item (Item)) loop
+      while Present (Item) loop
+
+         --  Do not inherit a chain that has been inherited already
+
+         if Item = From_Item then
+            return;
+         end if;
+
+         Last_Item := Item;
          Item := Next_Rep_Item (Item);
       end loop;
 
       --  When the destination type has a rep item chain, the chain of the
       --  source type is appended to it.
 
-      if Present (Item) then
-         Set_Next_Rep_Item (Item, From_Item);
+      if Present (Last_Item) then
+         Set_Next_Rep_Item (Last_Item, From_Item);
 
       --  Otherwise the destination type directly inherits the rep item chain
-      --  of the source type.
+      --  of the source type (if any).
 
       else
          Set_First_Rep_Item (Typ, From_Item);