2014-07-29 Robert Dewar <dewar@adacore.com>

	* einfo.adb (Derived_Type_Link): New function
	(Set_Derived_Type_Link): New procedure.
	(Write_Field31_Name): Output Derived_Type_Link.
	* einfo.ads: New field Derived_Type_Link.
	* exp_ch6.adb (Expand_Call): Warn if change of representation
	needed on call.
	* sem_ch13.adb: Minor addition of ??? comment.
	(Rep_Item_Too_Late): Warn on case that is legal but could cause an
	expensive implicit conversion.
	* sem_ch3.adb (Build_Derived_Type): Set Derived_Type_Link if needed.

2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch3.adb (Build_Init_Procedure): Renamed Local_DF_Id
	to DF_Id. Add new local variable DF_Call. Do not perform any
	elaboration-related checks on the call to the partial finalization
	routine within an init proc to avoid generating bogus elaboration
	warnings on expansion-related code.
	* sem_elab.adb (Check_A_Call): Move constant Access_Case to
	the top level of the routine.  Ensure that Output_Calls takes
	into account flags -gnatel and -gnatwl when emitting warnings
	or info messages.
	(Check_Internal_Call_Continue): Update the call to Output_Calls.
	(Elab_Warning): Moved to the top level of routine Check_A_Call.
	(Emit): New routines.
	(Output_Calls): Add new formal parameter Check_Elab_Flag along with a
	comment on usage. Output all warnings or info messages only when the
	caller context demands it and the proper elaboration flag is set.

2014-07-29  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Analyze_Attribute/Attribute_Old):
	Check rule about Old appearing in potentially unevaluated
	expression everywhere, not only in Post.

2014-07-29  Arnaud Charlet  <charlet@adacore.com>

	* sem_prag.adb: Update comment.
	* a-except.adb, a-except-2005.adb: Minor editing.

2014-07-29  Pierre-Marie Derodat  <derodat@adacore.com>

	* exp_dbug.adb (Debug_Renaming_Declaration):
	Do not create renaming entities for renamings of non-packed
	objects and for exceptions.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213175 138bc75d-0d04-0410-961f-82ee72b054a4

13 files changed, 392 insertions, 164 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 58a3246b520..a04acf4e2a3 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,53 @@
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
+	* einfo.adb (Derived_Type_Link): New function
+	(Set_Derived_Type_Link): New procedure.
+	(Write_Field31_Name): Output Derived_Type_Link.
+	* einfo.ads: New field Derived_Type_Link.
+	* exp_ch6.adb (Expand_Call): Warn if change of representation
+	needed on call.
+	* sem_ch13.adb: Minor addition of ??? comment.
+	(Rep_Item_Too_Late): Warn on case that is legal but could cause an
+	expensive implicit conversion.
+	* sem_ch3.adb (Build_Derived_Type): Set Derived_Type_Link if needed.
+
+2014-07-29  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Build_Init_Procedure): Renamed Local_DF_Id
+	to DF_Id. Add new local variable DF_Call. Do not perform any
+	elaboration-related checks on the call to the partial finalization
+	routine within an init proc to avoid generating bogus elaboration
+	warnings on expansion-related code.
+	* sem_elab.adb (Check_A_Call): Move constant Access_Case to
+	the top level of the routine.  Ensure that Output_Calls takes
+	into account flags -gnatel and -gnatwl when emitting warnings
+	or info messages.
+	(Check_Internal_Call_Continue): Update the call to Output_Calls.
+	(Elab_Warning): Moved to the top level of routine Check_A_Call.
+	(Emit): New routines.
+	(Output_Calls): Add new formal parameter Check_Elab_Flag along with a
+	comment on usage. Output all warnings or info messages only when the
+	caller context demands it and the proper elaboration flag is set.
+
+2014-07-29  Yannick Moy  <moy@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute/Attribute_Old):
+	Check rule about Old appearing in potentially unevaluated
+	expression everywhere, not only in Post.
+
+2014-07-29  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_prag.adb: Update comment.
+	* a-except.adb, a-except-2005.adb: Minor editing.
+
+2014-07-29  Pierre-Marie Derodat  <derodat@adacore.com>
+
+	* exp_dbug.adb (Debug_Renaming_Declaration):
+	Do not create renaming entities for renamings of non-packed
+	objects and for exceptions.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch3.adb, sinfo.ads, types.ads, sem_prag.adb, a-except-2005.adb,
 	sem_ch6.adb, par-ch3.adb: Minor reformatting.
 
diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb
index 168a619aece..2cedb8375a7 100644
--- a/gcc/ada/a-except-2005.adb
+++ b/gcc/ada/a-except-2005.adb
@@ -404,17 +404,6 @@ package body Ada.Exceptions is
    --  attached. The parameters are the file name and line number in each
    --  case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
 
-   --  Note on ordering of these routines. Normally in the Ada.Exceptions units
-   --  we don't care about the ordering of entries for Rcheck routines, and
-   --  the normal approach is to keep them in the same order as declarations
-   --  in Types.
-
-   --  This section is an IMPORTANT EXCEPTION. It is essential that the
-   --  routines in this section be declared in the same order as the Rmsg_xx
-   --  constants in the following section. This is required by the .Net runtime
-   --  which uses the exceptmsg.awk script to generate require exception data,
-   --  and this script requires and expects that this ordering rule holds.
-
    procedure Rcheck_CE_Access_Check
      (File : System.Address; Line : Integer);
    procedure Rcheck_CE_Null_Access_Parameter
diff --git a/gcc/ada/a-except.adb b/gcc/ada/a-except.adb
index 61632046972..dbde478260b 100644
--- a/gcc/ada/a-except.adb
+++ b/gcc/ada/a-except.adb
@@ -360,6 +360,17 @@ package body Ada.Exceptions is
    --  attached. The parameters are the file name and line number in each
    --  case. The names are defined by Exp_Ch11.Get_RT_Exception_Name.
 
+   --  Note on ordering of these routines. Normally in the Ada.Exceptions units
+   --  we don't care about the ordering of entries for Rcheck routines, and
+   --  the normal approach is to keep them in the same order as declarations
+   --  in Types.
+
+   --  This section is an IMPORTANT EXCEPTION. It is essential that the
+   --  routines in this section be declared in the same order as the Rmsg_xx
+   --  constants in the following section. This is required by the .Net runtime
+   --  which uses the exceptmsg.awk script to generate require exception data,
+   --  and this script requires and expects that this ordering rule holds.
+
    procedure Rcheck_CE_Access_Check
      (File : System.Address; Line : Integer);
    procedure Rcheck_CE_Null_Access_Parameter
@@ -418,8 +429,6 @@ package body Ada.Exceptions is
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Potentially_Blocking_Operation
      (File : System.Address; Line : Integer);
-   procedure Rcheck_PE_Stream_Operation_Not_Allowed
-     (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Stubbed_Subprogram_Called
      (File : System.Address; Line : Integer);
    procedure Rcheck_PE_Unchecked_Union_Restriction
@@ -432,6 +441,8 @@ package body Ada.Exceptions is
      (File : System.Address; Line : Integer);
    procedure Rcheck_SE_Object_Too_Large
      (File : System.Address; Line : Integer);
+   procedure Rcheck_PE_Stream_Operation_Not_Allowed
+     (File : System.Address; Line : Integer);
 
    procedure Rcheck_PE_Finalize_Raised_Exception
      (File : System.Address; Line : Integer);
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 80f5be05278..c815c189c4a 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -249,6 +249,7 @@ package body Einfo is
    --    Last_Aggregate_Assignment       Node30
    --    Static_Initialization           Node30
 
+   --    Derived_Type_Link               Node31
    --    Thunk_Entity                    Node31
 
    --    SPARK_Pragma                    Node32
@@ -949,6 +950,12 @@ package body Einfo is
       return Flag14 (Id);
    end Depends_On_Private;
 
+   function Derived_Type_Link (Id : E) return E is
+   begin
+      pragma Assert (Is_Type (Id));
+      return Node31 (Base_Type (Id));
+   end Derived_Type_Link;
+
    function Digits_Value (Id : E) return U is
    begin
       pragma Assert
@@ -3682,6 +3689,12 @@ package body Einfo is
       Set_Flag14 (Id, V);
    end Set_Depends_On_Private;
 
+   procedure Set_Derived_Type_Link (Id : E; V : E) is
+   begin
+      pragma Assert (Is_Type (Id) and then Is_Base_Type (Id));
+      Set_Node31 (Id, V);
+   end Set_Derived_Type_Link;
+
    procedure Set_Digits_Value (Id : E; V : U) is
    begin
       pragma Assert
@@ -9596,6 +9609,9 @@ package body Einfo is
               E_Function                                   =>
             Write_Str ("Thunk_Entity");
 
+         when Type_Kind                                    =>
+            Write_Str ("Derived_Type_Link");
+
          when others                                       =>
             Write_Str ("Field31??");
       end case;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6065d19ba94..fb64097da80 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -819,6 +819,28 @@ package Einfo is
 --       Defined in all type entities. Set if the type is private or if it
 --       depends on a private type.
 
+--    Derived_Type_Link (Node31)
+--       Defined in all type and subtype entries. Set in a base type if
+--       a derived type declaration is encountered which derives from
+--       this base type or one of its subtypes, and there are already
+--       primitive operations declared. In this case, it references the
+--       entity for the type declared by the derived type declaration.
+--       For example:
+--
+--          type R is ...
+--          subtype RS is R ...
+--          ...
+--          type G is new RS ...
+--
+--       In this case, if primitive operations have been declared for R, at
+--       the point of declaration of G, then the Derived_Type_Link of R is set
+--       to point to the entity for G. This is used to generate warnings for
+--       rep clauses that appear later on for R, which might result in an
+--       unexpected implicit conversion operation.
+--
+--       Note: if there is more than one such derived type, the link will point
+--       to the last one (this is only used in generating warning messages).
+
 --    Designated_Type (synthesized)
 --       Applies to access types. Returns the designated type. Differs from
 --       Directly_Designated_Type in that if the access type refers to an
@@ -5199,6 +5221,7 @@ package Einfo is
    --    Related_Expression                  (Node24)
    --    Current_Use_Clause                  (Node27)
    --    Subprograms_For_Type                (Node29)
+   --    Derived_Type_Link                   (Node31)
    --    Linker_Section_Pragma               (Node33)
 
    --    Depends_On_Private                  (Flag14)
@@ -6461,6 +6484,7 @@ package Einfo is
    function Delta_Value                         (Id : E) return R;
    function Dependent_Instances                 (Id : E) return L;
    function Depends_On_Private                  (Id : E) return B;
+   function Derived_Type_Link                   (Id : E) return E;
    function Digits_Value                        (Id : E) return U;
    function Direct_Primitive_Operations         (Id : E) return L;
    function Directly_Designated_Type            (Id : E) return E;
@@ -7095,6 +7119,7 @@ package Einfo is
    procedure Set_Delta_Value                     (Id : E; V : R);
    procedure Set_Dependent_Instances             (Id : E; V : L);
    procedure Set_Depends_On_Private              (Id : E; V : B := True);
+   procedure Set_Derived_Type_Link               (Id : E; V : E);
    procedure Set_Digits_Value                    (Id : E; V : U);
    procedure Set_Direct_Primitive_Operations     (Id : E; V : L);
    procedure Set_Directly_Designated_Type        (Id : E; V : E);
@@ -7841,6 +7866,7 @@ package Einfo is
    pragma Inline (Delta_Value);
    pragma Inline (Dependent_Instances);
    pragma Inline (Depends_On_Private);
+   pragma Inline (Derived_Type_Link);
    pragma Inline (Digits_Value);
    pragma Inline (Direct_Primitive_Operations);
    pragma Inline (Directly_Designated_Type);
@@ -8322,6 +8348,7 @@ package Einfo is
    pragma Inline (Set_Delta_Value);
    pragma Inline (Set_Dependent_Instances);
    pragma Inline (Set_Depends_On_Private);
+   pragma Inline (Set_Derived_Type_Link);
    pragma Inline (Set_Digits_Value);
    pragma Inline (Set_Direct_Primitive_Operations);
    pragma Inline (Set_Directly_Designated_Type);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index ae9f911cea3..5a6b0f9918b 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -2596,7 +2596,7 @@ package body Exp_Ch3 is
          Set_Statements (Handled_Stmt_Node, Body_Stmts);
 
          --  Generate:
-         --    Local_DF_Id (_init, C1, ..., CN);
+         --    Deep_Finalize (_init, C1, ..., CN);
          --    raise;
 
          if Counter > 0
@@ -2605,30 +2605,36 @@ package body Exp_Ch3 is
            and then not Restriction_Active (No_Exception_Propagation)
          then
             declare
-               Local_DF_Id : Entity_Id;
+               DF_Call : Node_Id;
+               DF_Id   : Entity_Id;
 
             begin
                --  Create a local version of Deep_Finalize which has indication
                --  of partial initialization state.
 
-               Local_DF_Id := Make_Temporary (Loc, 'F');
+               DF_Id := Make_Temporary (Loc, 'F');
 
-               Append_To (Decls,
-                 Make_Local_Deep_Finalize (Rec_Type, Local_DF_Id));
+               Append_To (Decls, Make_Local_Deep_Finalize (Rec_Type, DF_Id));
+
+               DF_Call :=
+                 Make_Procedure_Call_Statement (Loc,
+                   Name                   => New_Occurrence_Of (DF_Id, Loc),
+                   Parameter_Associations => New_List (
+                     Make_Identifier (Loc, Name_uInit),
+                     New_Occurrence_Of (Standard_False, Loc)));
+
+               --  Do not emit warnings related to the elaboration order when a
+               --  controlled object is declared before the body of Finalize is
+               --  seen.
+
+               Set_No_Elaboration_Check (DF_Call);
 
                Set_Exception_Handlers (Handled_Stmt_Node, New_List (
                  Make_Exception_Handler (Loc,
                    Exception_Choices => New_List (
                      Make_Others_Choice (Loc)),
-
-                   Statements => New_List (
-                     Make_Procedure_Call_Statement (Loc,
-                       Name                   =>
-                         New_Occurrence_Of (Local_DF_Id, Loc),
-                       Parameter_Associations => New_List (
-                         Make_Identifier (Loc, Name_uInit),
-                         New_Occurrence_Of (Standard_False, Loc))),
-
+                   Statements        => New_List (
+                     DF_Call,
                      Make_Raise_Statement (Loc)))));
             end;
          else
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 703a4279d48..2e4ef82aea1 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3705,19 +3705,27 @@ package body Exp_Ch6 is
                         Resolve (Actual, Parent_Typ);
                      end if;
 
+                  --  If there is a change of representation, then generate a
+                  --  warning, and do the change of representation.
+
+                  elsif not Same_Representation (Formal_Typ, Parent_Typ) then
+                     Error_Msg_N
+                       ("??change of representation required", Actual);
+                     Convert (Actual, Parent_Typ);
+
                   --  For array and record types, the parent formal type and
                   --  derived formal type have different sizes or pragma Pack
                   --  status.
 
                   elsif ((Is_Array_Type (Formal_Typ)
-                            and then Is_Array_Type (Parent_Typ))
+                           and then Is_Array_Type (Parent_Typ))
                        or else
                          (Is_Record_Type (Formal_Typ)
-                            and then Is_Record_Type (Parent_Typ)))
+                           and then Is_Record_Type (Parent_Typ)))
                     and then
                       (Esize (Formal_Typ) /= Esize (Parent_Typ)
-                         or else Has_Pragma_Pack (Formal_Typ) /=
-                                 Has_Pragma_Pack (Parent_Typ))
+                        or else Has_Pragma_Pack (Formal_Typ) /=
+                                Has_Pragma_Pack (Parent_Typ))
                   then
                      Convert (Actual, Parent_Typ);
                   end if;
diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index e184cb6a263..5e0d614feaf 100644
--- a/gcc/ada/exp_dbug.adb
+++ b/gcc/ada/exp_dbug.adb
@@ -306,6 +306,16 @@ package body Exp_Dbug is
       Obj : Entity_Id;
       Res : Node_Id;
 
+      Enable : Boolean := Nkind (N) = N_Package_Renaming_Declaration;
+      --  By default, we do not generate an encoding for renaming. This is
+      --  however done (in which case this is set to True) in a few cases:
+      --    - when a package is renamed,
+      --    - when the renaming involves a packed array,
+      --    - when the renaming involves a packed record.
+
+      procedure Enable_If_Packed_Array (N : Node_Id);
+      --  Enable encoding generation if N is a packed array
+
       function Output_Subscript (N : Node_Id; S : String) return Boolean;
       --  Outputs a single subscript value as ?nnn (subscript is compile time
       --  known value with value nnn) or as ?e (subscript is local constant
@@ -314,6 +324,21 @@ package body Exp_Dbug is
       --  output in one of these two forms. The result is prepended to the
       --  name stored in Name_Buffer.
 
+      ----------------------------
+      -- Enable_If_Packed_Array --
+      ----------------------------
+
+      procedure Enable_If_Packed_Array (N : Node_Id) is
+         T : constant Entity_Id := Etype (N);
+      begin
+         Enable :=
+           (Enable
+               or else
+            (Ekind (T) in Array_Kind
+               and then
+             Present (Packed_Array_Impl_Type (T))));
+      end Enable_If_Packed_Array;
+
       ----------------------
       -- Output_Subscript --
       ----------------------
@@ -372,6 +397,8 @@ package body Exp_Dbug is
                exit;
 
             when N_Selected_Component =>
+               Enable :=
+                 Enable or else Is_Packed (Etype (Prefix (Ren)));
                Prepend_String_To_Buffer
                  (Get_Name_String (Chars (Selector_Name (Ren))));
                Prepend_String_To_Buffer ("XR");
@@ -382,6 +409,7 @@ package body Exp_Dbug is
                   X : Node_Id := Last (Expressions (Ren));
 
                begin
+                  Enable_If_Packed_Array (Prefix (Ren));
                   while Present (X) loop
                      if not Output_Subscript (X, "XS") then
                         Set_Materialize_Entity (Ent);
@@ -396,6 +424,7 @@ package body Exp_Dbug is
 
             when N_Slice =>
 
+               Enable_If_Packed_Array (Prefix (Ren));
                Typ := Etype (First_Index (Etype (Nam)));
 
                if not Output_Subscript (Type_High_Bound (Typ), "XS") then
@@ -422,6 +451,13 @@ package body Exp_Dbug is
          end case;
       end loop;
 
+      --  If we found no reason here to emit an encoding, stop now.
+
+      if not Enable then
+         Set_Materialize_Entity (Ent);
+         return Empty;
+      end if;
+
       Prepend_String_To_Buffer ("___XE");
 
       --  Include the designation of the form of renaming
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 0495c7c9668..09ab6075662 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -4564,25 +4564,11 @@ package body Sem_Attr is
 
             --  Ensure that the obtained expression is the consequence of a
             --  contract case as this is the only postcondition-like part of
-            --  the pragma.
+            --  the pragma. Otherwise, attribute 'Old appears in the condition
+            --  of a contract case. Emit an error since this is not a
+            --  postcondition-like context. (SPARK RM 6.1.3(2))
 
-            if Expr = Expression (Parent (Expr)) then
-
-               --  Warn that a potentially unevaluated prefix is always
-               --  evaluated when the corresponding consequence is selected.
-
-               if Is_Potentially_Unevaluated (P) then
-                  Error_Msg_Name_1 := Aname;
-                  Error_Msg_N
-                    ("??prefix of attribute % is always evaluated when "
-                     & "related consequence is selected", P);
-               end if;
-
-            --  Attribute 'Old appears in the condition of a contract case.
-            --  Emit an error since this is not a postcondition-like context.
-            --  (SPARK RM 6.1.3(2))
-
-            else
+            if Expr /= Expression (Parent (Expr)) then
                Error_Attr
                  ("attribute % cannot appear in the condition "
                   & "of a contract case", P);
@@ -4773,11 +4759,10 @@ package body Sem_Attr is
               ("??attribute Old applied to constant has no effect", P);
          end if;
 
-         --  Check that the prefix of 'Old is an entity, when it appears in
-         --  a postcondition and may be potentially unevaluated (6.1.1 (27/3)).
+         --  Check that the prefix of 'Old is an entity when it may be
+         --  potentially unevaluated (6.1.1 (27/3)).
 
          if Present (Prag)
-           and then Get_Pragma_Id (Prag) = Pragma_Postcondition
            and then Is_Potentially_Unevaluated (N)
            and then not Is_Entity_Name (P)
          then
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index e63d4dde263..fc09f6f3d08 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11074,6 +11074,9 @@ package body Sem_Ch13 is
       --  Note that neither of the above errors is considered a serious one,
       --  since the effect is simply that we ignore the representation clause
       --  in these cases.
+      --  Is this really true? In any case if we make this change we must
+      --  document the requirement in the spec of Rep_Item_Too_Late that
+      --  if True is returned, then the rep item must be completely ignored???
 
       ----------------------
       -- No_Type_Rep_Item --
@@ -11122,8 +11125,10 @@ package body Sem_Ch13 is
          S := First_Subtype (T);
 
          if Present (Freeze_Node (S)) then
-            Error_Msg_NE
-              ("??no more representation items for }", Freeze_Node (S), S);
+            if not Relaxed_RM_Semantics then
+               Error_Msg_NE
+                 ("??no more representation items for }", Freeze_Node (S), S);
+            end if;
          end if;
 
          return True;
@@ -11142,18 +11147,68 @@ package body Sem_Ch13 is
 
          if Has_Primitive_Operations (Parent_Type) then
             No_Type_Rep_Item;
-            Error_Msg_NE
-              ("\parent type & has primitive operations!", N, Parent_Type);
+
+            if not Relaxed_RM_Semantics then
+               Error_Msg_NE
+                 ("\parent type & has primitive operations!", N, Parent_Type);
+            end if;
+
             return True;
 
          elsif Is_By_Reference_Type (Parent_Type) then
             No_Type_Rep_Item;
-            Error_Msg_NE
-              ("\parent type & is a by reference type!", N, Parent_Type);
+
+            if not Relaxed_RM_Semantics then
+               Error_Msg_NE
+                 ("\parent type & is a by reference type!", N, Parent_Type);
+            end if;
+
             return True;
          end if;
       end if;
 
+      --  No error, but one more warning to consider. The RM (surprisingly)
+      --  allows this pattern:
+
+      --    type S is ...
+      --    primitive operations for S
+      --    type R is new S;
+      --    rep clause for S
+
+      --  Meaning that calls on the primitive operations of S for values of
+      --  type R may require possibly expensive implicit conversion operations.
+      --  This is not an error, but is worth a warning.
+
+      if not Relaxed_RM_Semantics and then Is_Type (T) then
+         declare
+            DTL : constant Entity_Id := Derived_Type_Link (Base_Type (T));
+
+         begin
+            if Present (DTL)
+              and then Has_Primitive_Operations (Base_Type (T))
+
+              --  For now, do not generate this warning for the case of aspect
+              --  specification using Ada 2012 syntax, since we get wrong
+              --  messages we do not understand. The whole business of derived
+              --  types and rep items seems a bit confused when aspects are
+              --  used, since the aspects are not evaluated till freeze time.
+
+              and then not From_Aspect_Specification (N)
+            then
+               Error_Msg_Sloc := Sloc (DTL);
+               Error_Msg_N
+                 ("representation item for& appears after derived type "
+                  & "declaration#??", N);
+               Error_Msg_NE
+                 ("\may result in implicit conversions for primitive "
+                  & "operations of&??", N, T);
+               Error_Msg_NE
+                 ("\to change representations when called with arguments "
+                  & "of type&??", N, DTL);
+            end if;
+         end;
+      end if;
+
       --  No error, link item into head of chain of rep items for the entity,
       --  but avoid chaining if we have an overloadable entity, and the pragma
       --  is one that can apply to multiple overloaded entities.
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9c70acb5d5b..506a4b082e0 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -8503,6 +8503,12 @@ package body Sem_Ch3 is
       Set_Is_Controlled  (Derived_Type, Is_Controlled  (Parent_Type));
       Set_Is_Tagged_Type (Derived_Type, Is_Tagged_Type (Parent_Type));
 
+      --  If the parent has primitive routines, set the derived type link
+
+      if Has_Primitive_Operations (Parent_Type) then
+         Set_Derived_Type_Link (Parent_Base, Derived_Type);
+      end if;
+
       --  If the parent type is a private subtype, the convention on the base
       --  type may be set in the private part, and not propagated to the
       --  subtype until later, so we obtain the convention from the base type.
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index e8f68e5ab30..adf5fd123c1 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -263,11 +263,15 @@ package body Sem_Elab is
    function Is_Finalization_Procedure (Id : Entity_Id) return Boolean;
    --  Determine whether entity Id denotes a [Deep_]Finalize procedure
 
-   procedure Output_Calls (N : Node_Id);
+   procedure Output_Calls
+     (N               : Node_Id;
+      Check_Elab_Flag : Boolean);
    --  Outputs chain of calls stored in the Elab_Call table. The caller has
    --  already generated the main warning message, so the warnings generated
    --  are all continuation messages. The argument is the call node at which
-   --  the messages are to be placed.
+   --  the messages are to be placed. When Check_Elab_Flag is set, calls are
+   --  enumerated only when flag Elab_Warning is set for the dynamic case or
+   --  when flag Elab_Info_Messages is set for the statis case.
 
    function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean;
    --  Given two scopes, determine whether they are the same scope from an
@@ -497,6 +501,48 @@ package body Sem_Elab is
       Generate_Warnings : Boolean := True;
       In_Init_Proc      : Boolean := False)
    is
+      Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
+      --  Indicates if we have Access attribute case
+
+      procedure Elab_Warning
+        (Msg_D : String;
+         Msg_S : String;
+         Ent   : Node_Or_Entity_Id);
+       --  Generate a call to Error_Msg_NE with parameters Msg_D or Msg_S (for
+       --  dynamic or static elaboration model), N and Ent. Msg_D is a real
+       --  warning (output if Msg_D is non-null and Elab_Warnings is set),
+       --  Msg_S is an info message (output if Elab_Info_Messages is set.
+
+      ------------------
+      -- Elab_Warning --
+      ------------------
+
+      procedure Elab_Warning
+        (Msg_D : String;
+         Msg_S : String;
+         Ent   : Node_Or_Entity_Id)
+      is
+      begin
+         --  Dynamic elaboration checks, real warning
+
+         if Dynamic_Elaboration_Checks then
+            if not Access_Case then
+               if Msg_D /= "" and then Elab_Warnings then
+                  Error_Msg_NE (Msg_D, N, Ent);
+               end if;
+            end if;
+
+         --  Static elaboration checks, info message
+
+         else
+            if Elab_Info_Messages then
+               Error_Msg_NE (Msg_S, N, Ent);
+            end if;
+         end if;
+      end Elab_Warning;
+
+      --  Local variables
+
       Loc  : constant Source_Ptr := Sloc (N);
       Ent  : Entity_Id;
       Decl : Node_Id;
@@ -525,9 +571,6 @@ package body Sem_Elab is
       Inst_Case : constant Boolean := Nkind (N) in N_Generic_Instantiation;
       --  Indicates if we have instantiation case
 
-      Access_Case : constant Boolean := Nkind (N) = N_Attribute_Reference;
-      --  Indicates if we have Access attribute case
-
       Caller_Unit_Internal : Boolean;
       Callee_Unit_Internal : Boolean;
 
@@ -544,6 +587,8 @@ package body Sem_Elab is
       --  warnings on the scope are also suppressed. For the internal case,
       --  we ignore this flag.
 
+   --  Start of processing for Check_A_Call
+
    begin
       --  If the call is known to be within a local Suppress Elaboration
       --  pragma, nothing to check. This can happen in task bodies. But
@@ -873,101 +918,64 @@ package body Sem_Elab is
            and then (Elab_Warnings or Elab_Info_Messages)
            and then Generate_Warnings
          then
-            Generate_Elab_Warnings : declare
-               procedure Elab_Warning
-                 (Msg_D : String;
-                  Msg_S : String;
-                  Ent   : Node_Or_Entity_Id);
-               --  Generate a call to Error_Msg_NE with parameters Msg_D or
-               --  Msg_S (for dynamic or static elaboration model), N and Ent.
-               --  Msg_D is a real warning (output if Msg_D is non-null and
-               --  Elab_Warnings is set), Msg_S is an info message (output if
-               --  Elab_Info_Messages is set.
-
-               ------------------
-               -- Elab_Warning --
-               ------------------
-
-               procedure Elab_Warning
-                 (Msg_D : String;
-                  Msg_S : String;
-                  Ent   : Node_Or_Entity_Id)
-               is
-               begin
-                  --  Dynamic elaboration checks, real warning
-
-                  if Dynamic_Elaboration_Checks then
-                     if not Access_Case then
-                        if Msg_D /= "" and then Elab_Warnings then
-                           Error_Msg_NE (Msg_D, N, Ent);
-                        end if;
-                     end if;
+            --  Instantiation case
 
-                  --  Static elaboration checks, info message
-
-                  else
-                     if Elab_Info_Messages then
-                        Error_Msg_NE (Msg_S, N, Ent);
-                     end if;
-                  end if;
-               end Elab_Warning;
-
-            --  Start of processing for Generate_Elab_Warnings
+            if Inst_Case then
+               Elab_Warning
+                 ("instantiation of& may raise Program_Error?l?",
+                  "info: instantiation of& during elaboration?$?", Ent);
 
-            begin
-               --  Instantiation case
+            --  Indirect call case, info message only in static elaboration
+            --  case, because the attribute reference itself cannot raise an
+            --  exception.
 
-               if Inst_Case then
-                  Elab_Warning
-                    ("instantiation of& may raise Program_Error?l?",
-                     "info: instantiation of& during elaboration?$?", Ent);
+            elsif Access_Case then
+               Elab_Warning
+                 ("", "info: access to& during elaboration?$?", Ent);
 
-               --  Indirect call case, info message only in static elaboration
-               --  case, because the attribute reference itself cannot raise
-               --  an exception.
+            --  Subprogram call case
 
-               elsif Access_Case then
+            else
+               if Nkind (Name (N)) in N_Has_Entity
+                 and then Is_Init_Proc (Entity (Name (N)))
+                 and then Comes_From_Source (Ent)
+               then
                   Elab_Warning
-                    ("", "info: access to& during elaboration?$?", Ent);
-
-               --  Subprogram call case
+                    ("implicit call to & may raise Program_Error?l?",
+                     "info: implicit call to & during elaboration?$?",
+                     Ent);
 
                else
-                  if Nkind (Name (N)) in N_Has_Entity
-                    and then Is_Init_Proc (Entity (Name (N)))
-                    and then Comes_From_Source (Ent)
-                  then
-                     Elab_Warning
-                       ("implicit call to & may raise Program_Error?l?",
-                        "info: implicit call to & during elaboration?$?",
-                        Ent);
-
-                  else
-                     Elab_Warning
-                       ("call to & may raise Program_Error?l?",
-                        "info: call to & during elaboration?$?",
-                        Ent);
-                  end if;
+                  Elab_Warning
+                    ("call to & may raise Program_Error?l?",
+                     "info: call to & during elaboration?$?",
+                     Ent);
                end if;
+            end if;
 
-               Error_Msg_Qual_Level := Nat'Last;
+            Error_Msg_Qual_Level := Nat'Last;
 
-               if Nkind (N) in N_Subprogram_Instantiation then
-                  Elab_Warning
-                    ("\missing pragma Elaborate for&?l?",
-                     "\implicit pragma Elaborate for& generated?$?",
-                     W_Scope);
+            if Nkind (N) in N_Subprogram_Instantiation then
+               Elab_Warning
+                 ("\missing pragma Elaborate for&?l?",
+                  "\implicit pragma Elaborate for& generated?$?",
+                  W_Scope);
 
-               else
-                  Elab_Warning
-                    ("\missing pragma Elaborate_All for&?l?",
-                     "\implicit pragma Elaborate_All for & generated?$?",
-                     W_Scope);
-               end if;
-            end Generate_Elab_Warnings;
+            else
+               Elab_Warning
+                 ("\missing pragma Elaborate_All for&?l?",
+                  "\implicit pragma Elaborate_All for & generated?$?",
+                  W_Scope);
+            end if;
 
             Error_Msg_Qual_Level := 0;
-            Output_Calls (N);
+
+            --  Take into account the flags related to elaboration warning
+            --  messages when enumerating the various calls involved. This
+            --  ensures the proper pairing of the main warning and the
+            --  clarification messages generated by Output_Calls.
+
+            Output_Calls (N, Check_Elab_Flag => True);
 
             --  Set flag to prevent further warnings for same unit unless in
             --  All_Errors_Mode.
@@ -2316,7 +2324,12 @@ package body Sem_Elab is
 
             Error_Msg_N ("\Program_Error ]<l<", N);
 
-            Output_Calls (N);
+            --  There is no need to query the elaboration warning message flags
+            --  because the main message is an error, not a warning, therefore
+            --  all the clarification messages produces by Output_Calls must be
+            --  emitted unconditionally.
+
+            Output_Calls (N, Check_Elab_Flag => False);
          end if;
       end if;
 
@@ -3053,8 +3066,13 @@ package body Sem_Elab is
    -- Output_Calls --
    ------------------
 
-   procedure Output_Calls (N : Node_Id) is
-      Ent : Entity_Id;
+   procedure Output_Calls
+     (N               : Node_Id;
+      Check_Elab_Flag : Boolean)
+   is
+      function Emit (Flag : Boolean) return Boolean;
+      --  Determine whether to emit an error message based on the combination
+      --  of flags Check_Elab_Flag and Flag.
 
       function Is_Printable_Error_Name (Nm : Name_Id) return Boolean;
       --  An internal function, used to determine if a name, Nm, is either
@@ -3062,6 +3080,19 @@ package body Sem_Elab is
       --  by the error message circuits (i.e. it has a single upper
       --  case letter at the end).
 
+      ----------
+      -- Emit --
+      ----------
+
+      function Emit (Flag : Boolean) return Boolean is
+      begin
+         if Check_Elab_Flag then
+            return Flag;
+         else
+            return True;
+         end if;
+      end Emit;
+
       -----------------------------
       -- Is_Printable_Error_Name --
       -----------------------------
@@ -3080,6 +3111,10 @@ package body Sem_Elab is
          end if;
       end Is_Printable_Error_Name;
 
+      --  Local variables
+
+      Ent : Entity_Id;
+
    --  Start of processing for Output_Calls
 
    begin
@@ -3091,27 +3126,31 @@ package body Sem_Elab is
          --  Dynamic elaboration model, warnings controlled by -gnatwl
 
          if Dynamic_Elaboration_Checks then
-            if Is_Generic_Unit (Ent) then
-               Error_Msg_NE ("\\?l?& instantiated #", N, Ent);
-            elsif Is_Init_Proc (Ent) then
-               Error_Msg_N ("\\?l?initialization procedure called #", N);
-            elsif Is_Printable_Error_Name (Chars (Ent)) then
-               Error_Msg_NE ("\\?l?& called #", N, Ent);
-            else
-               Error_Msg_N ("\\?l?called #", N);
+            if Emit (Elab_Warnings) then
+               if Is_Generic_Unit (Ent) then
+                  Error_Msg_NE ("\\?l?& instantiated #", N, Ent);
+               elsif Is_Init_Proc (Ent) then
+                  Error_Msg_N ("\\?l?initialization procedure called #", N);
+               elsif Is_Printable_Error_Name (Chars (Ent)) then
+                  Error_Msg_NE ("\\?l?& called #", N, Ent);
+               else
+                  Error_Msg_N ("\\?l?called #", N);
+               end if;
             end if;
 
          --  Static elaboration model, info messages controlled by -gnatel
 
          else
-            if Is_Generic_Unit (Ent) then
-               Error_Msg_NE ("\\?$?& instantiated #", N, Ent);
-            elsif Is_Init_Proc (Ent) then
-               Error_Msg_N ("\\?$?initialization procedure called #", N);
-            elsif Is_Printable_Error_Name (Chars (Ent)) then
-               Error_Msg_NE ("\\?$?& called #", N, Ent);
-            else
-               Error_Msg_N ("\\?$?called #", N);
+            if Emit (Elab_Info_Messages) then
+               if Is_Generic_Unit (Ent) then
+                  Error_Msg_NE ("\\?$?& instantiated #", N, Ent);
+               elsif Is_Init_Proc (Ent) then
+                  Error_Msg_N ("\\?$?initialization procedure called #", N);
+               elsif Is_Printable_Error_Name (Chars (Ent)) then
+                  Error_Msg_NE ("\\?$?& called #", N, Ent);
+               else
+                  Error_Msg_N ("\\?$?called #", N);
+               end if;
             end if;
          end if;
       end loop;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index bc3468da63c..16b93ab6d53 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -11022,7 +11022,9 @@ package body Sem_Prag is
 
             --  If Allow_Integer_Address is already set do nothing, otherwise
             --  calling RTE on RE_Address would cause a crash when loading
-            --  system.ads.
+            --  system.ads. ??? same will happen if Allow_Integer_Address is
+            --  not set actually, to be fixed and then the guard on
+            --  not Opt.Allow_Integer_Address should be removed.
 
             if not Opt.Allow_Integer_Address
               and then Is_Private_Type (RTE (RE_Address))