[multiple changes]

2014-08-01  Robert Dewar  <dewar@adacore.com>

	* sem_ch8.adb: Minor reformatting.

2014-08-01  Yannick Moy  <moy@adacore.com>

	* sem_ch13.adb (Insert_Pragma): Add special case for precondition
	pragmas from aspects, which need to be inserted in proper order.

2014-08-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Record_Aggregate, Init_Hidden_Discriminants):
	Handle properly a type extension that constrains a discriminated
	derived type that renames other discriminants of an ancestor.

2014-08-01  Thomas Quinot  <quinot@adacore.com>

	* s-pack06.adb, s-pack10.adb, s-pack03.ads, s-pack12.adb, s-pack14.ads,
	s-pack25.adb: Fix minor inconsistencies and typos.

From-SVN: r213469

10 files changed, 67 insertions, 28 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6461c13dd45..4c906dd6663 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2014-08-01  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch8.adb: Minor reformatting.
+
+2014-08-01  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch13.adb (Insert_Pragma): Add special case for precondition
+	pragmas from aspects, which need to be inserted in proper order.
+
+2014-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Expand_Record_Aggregate, Init_Hidden_Discriminants):
+	Handle properly a type extension that constrains a discriminated
+	derived type that renames other discriminants of an ancestor.
+
+2014-08-01  Thomas Quinot  <quinot@adacore.com>
+
+	* s-pack06.adb, s-pack10.adb, s-pack03.ads, s-pack12.adb, s-pack14.ads,
+	s-pack25.adb: Fix minor inconsistencies and typos.
+
 2014-08-01  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_ch8.adb (Analyze_Subprogram_Renaming): Alphabetize
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 557e3c82dfe..033ad011db8 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1845,7 +1845,9 @@ package body Exp_Aggr is
       procedure Init_Hidden_Discriminants (Typ : Entity_Id; List : List_Id);
       --  If Typ is derived, and constrains discriminants of the parent type,
       --  these discriminants are not components of the aggregate, and must be
-      --  initialized. The assignments are appended to List.
+      --  initialized. The assignments are appended to List. The same is done
+      --  if Typ derives fron an already constrained subtype of a discriminated
+      --  parent type.
 
       function Get_Explicit_Discriminant_Value (D : Entity_Id) return Node_Id;
       --  If the ancestor part is an unconstrained type and further ancestors
@@ -2113,13 +2115,30 @@ package body Exp_Aggr is
 
       begin
          Btype := Base_Type (Typ);
+
+         --  The constraints on the hidden discriminants, if present, are
+         --  kep in the Stored_Constraint list of the type itself, or in
+         --  that of the base type.
+
          while Is_Derived_Type (Btype)
-           and then Present (Stored_Constraint (Btype))
+           and then (Present (Stored_Constraint (Btype))
+             or else Present (Stored_Constraint (Typ)))
          loop
             Parent_Type := Etype (Btype);
+            if not Has_Discriminants (Parent_Type) then
+               return;
+            end if;
 
             Disc := First_Discriminant (Parent_Type);
-            Discr_Val := First_Elmt (Stored_Constraint (Base_Type (Typ)));
+
+            --  We know that one of the stored-constraint lists is present.
+
+            if Present (Stored_Constraint (Btype)) then
+               Discr_Val := First_Elmt (Stored_Constraint (Btype));
+            else
+               Discr_Val := First_Elmt (Stored_Constraint (Typ));
+            end if;
+
             while Present (Discr_Val) loop
 
                --  Only those discriminants of the parent that are not
diff --git a/gcc/ada/s-pack03.ads b/gcc/ada/s-pack03.ads
index f34428bacde..d8f35c70555 100644
--- a/gcc/ada/s-pack03.ads
+++ b/gcc/ada/s-pack03.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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,7 +29,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Handing of packed arrays with Component_Size = 3
+--  Handling of packed arrays with Component_Size = 3
 
 package System.Pack_03 is
    pragma Preelaborate;
diff --git a/gcc/ada/s-pack06.adb b/gcc/ada/s-pack06.adb
index e2e77b097e2..a8cf24e842b 100644
--- a/gcc/ada/s-pack06.adb
+++ b/gcc/ada/s-pack06.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -128,7 +128,6 @@ package body System.Pack_06 is
 
    procedure Set_06 (Arr : System.Address; N : Natural; E : Bits_06) is
       C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
@@ -148,7 +147,6 @@ package body System.Pack_06 is
 
    procedure SetU_06 (Arr : System.Address; N : Natural; E : Bits_06) is
       C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
diff --git a/gcc/ada/s-pack10.adb b/gcc/ada/s-pack10.adb
index 933969db394..0fbd13ef962 100644
--- a/gcc/ada/s-pack10.adb
+++ b/gcc/ada/s-pack10.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -128,7 +128,6 @@ package body System.Pack_10 is
 
    procedure Set_10 (Arr : System.Address; N : Natural; E : Bits_10) is
       C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
@@ -148,7 +147,6 @@ package body System.Pack_10 is
 
    procedure SetU_10 (Arr : System.Address; N : Natural; E : Bits_10) is
       C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
diff --git a/gcc/ada/s-pack12.adb b/gcc/ada/s-pack12.adb
index e12cd66ce32..d43cca14a24 100644
--- a/gcc/ada/s-pack12.adb
+++ b/gcc/ada/s-pack12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -128,7 +128,6 @@ package body System.Pack_12 is
 
    procedure Set_12 (Arr : System.Address; N : Natural; E : Bits_12) is
       C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
@@ -148,7 +147,6 @@ package body System.Pack_12 is
 
    procedure SetU_12 (Arr : System.Address; N : Natural; E : Bits_12) is
       C : constant ClusterU_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
diff --git a/gcc/ada/s-pack14.ads b/gcc/ada/s-pack14.ads
index 326d2e68c32..aecd6f089cd 100644
--- a/gcc/ada/s-pack14.ads
+++ b/gcc/ada/s-pack14.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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,7 +29,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  Handing of packed arrays with Component_Size = 14
+--  Handling of packed arrays with Component_Size = 14
 
 package System.Pack_14 is
    pragma Preelaborate;
diff --git a/gcc/ada/s-pack25.adb b/gcc/ada/s-pack25.adb
index 015d4030510..3d927c27e64 100644
--- a/gcc/ada/s-pack25.adb
+++ b/gcc/ada/s-pack25.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, 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- --
@@ -77,7 +77,6 @@ package body System.Pack_25 is
 
    function Get_25 (Arr : System.Address; N : Natural) return Bits_25 is
       C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => return C.E0;
@@ -97,7 +96,6 @@ package body System.Pack_25 is
 
    procedure Set_25 (Arr : System.Address; N : Natural; E : Bits_25) is
       C : constant Cluster_Ref := To_Ref (Arr + Bits * Ofs (Uns (N) / 8));
-
    begin
       case N07 (Uns (N) mod 8) is
          when 0 => C.E0 := E;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 86a36ced87f..a741cfffd4d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1283,10 +1283,19 @@ package body Sem_Ch13 is
                --  the proper insertion point. As a result the order of pragmas
                --  is the same as the order of aspects.
 
+               --  As precondition pragmas generated from conjuncts in the
+               --  precondition aspect are presented in reverse order to
+               --  Insert_Pragma, insert them in the correct order here by not
+               --  skipping previously inserted precondition pragmas when the
+               --  current pragma is a precondition.
+
                Decl := First (Declarations (N));
                while Present (Decl) loop
                   if Nkind (Decl) = N_Pragma
                     and then From_Aspect_Specification (Decl)
+                    and then not (Get_Pragma_Id (Decl) = Pragma_Precondition
+                                    and then
+                                  Get_Pragma_Id (Prag) = Pragma_Precondition)
                   then
                      Next (Decl);
                   else
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 01055d2265a..0e5c2e4e50f 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1830,28 +1830,28 @@ package body Sem_Ch8 is
       --  type with unknown discriminants and a generic primitive operation of
       --  the said type with a box require special processing when the actual
       --  is a class-wide type:
-
+      --
       --    generic
       --       type Formal_Typ (<>) is private;
       --       with procedure Prim_Op (Param : Formal_Typ) is <>;
       --    package Gen is ...
-
+      --
       --    package Inst is new Gen (Actual_Typ'Class);
-
+      --
       --  In this case the general renaming mechanism used in the prologue of
       --  an instance no longer applies:
-
+      --
       --    procedure Prim_Op (Param : Formal_Typ) renames Prim_Op;
-
+      --
       --  The above is replaced the following wrapper/renaming combination:
-
+      --
       --    procedure Prim_Op (Param : Formal_Typ) is  --  wrapper
       --    begin
       --       Prim_Op (Param);                        --  primitive
       --    end Wrapper;
-
+      --
       --    procedure Dummy (Param : Formal_Typ) renames Prim_Op;
-
+      --
       --  This transformation applies only if there is no explicit visible
       --  class-wide operation at the point of the instantiation. Ren_Id is
       --  the entity of the renaming declaration. Wrap_Id is the entity of
@@ -1937,7 +1937,6 @@ package body Sem_Ch8 is
             while Present (Formal) loop
                Append_To (Actuals,
                  Make_Identifier (Loc, Chars (Defining_Identifier (Formal))));
-
                Next (Formal);
             end loop;