[multiple changes]

2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* elists.ads, elists.adb (Prepend_Unique_Elmt): New routine.
	* exp_ch3.adb (Freeze_Type): Signal the DIC body is created for
	the purposes of freezing.
	* exp_util.adb Update the documentation and structure of the
	type map used in class-wide semantics of assertion expressions.
	(Add_Inherited_Tagged_DIC): There is really no need to preanalyze
	and resolve the triaged expression because all substitutions
	refer to the proper entities.  Update the replacement of
	references.
	(Build_DIC_Procedure_Body): Add formal parameter
	For_Freeze. Add local variable Build_Body. Inherited DIC pragmas
	are now only processed when freezing occurs.  Build a body only
	when one is needed.
	(Entity_Hash): Removed.
	(Map_Types): New routine.
	(Replace_Object_And_Primitive_References): Removed.
	(Replace_References): New routine.
	(Replace_Type_References): Moved to the library level of Exp_Util.
	(Type_Map_Hash): New routine.
	(Update_Primitives_Mapping): Update the mapping call.
	(Update_Primitives_Mapping_Of_Types): Removed.
	* exp_util.ads (Build_DIC_Procedure_Body): Add formal
	parameter For_Freeze and update the comment on usage.
	(Map_Types): New routine.
	(Replace_References): New routine.
	(Replace_Type_References): Moved to the library level of Exp_Util.
	(Update_Primitives_Mapping_Of_Types): Removed.
	* sem_ch7.adb (Preserve_Full_Attributes): Propagate the DIC
	properties of the private type to the full view in case the full
	view derives from a parent type and inherits a DIC pragma.
	* sem_prag.adb (Analyze_Pragma): Guard against a case where a
	DIC pragma is placed at the top of a declarative region.

2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>

	* a-tasatt.adb: Complete previous change and use an unsigned
	int to avoid overflow checks.

2017-04-25  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Access): Specialize
	the error message when the attribute reference is an actual in
	a call to a subprogram inherited from a generic formal type with
	unknown discriminants, which makes the subprogram and its formal
	parameters intrinsic (see RM 6.3.1 (8) and (13)).

From-SVN: r247148

gcc/ada/ChangeLog

 2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* elists.ads, elists.adb (Prepend_Unique_Elmt): New routine.
+	* exp_ch3.adb (Freeze_Type): Signal the DIC body is created for
+	the purposes of freezing.
+	* exp_util.adb Update the documentation and structure of the
+	type map used in class-wide semantics of assertion expressions.
+	(Add_Inherited_Tagged_DIC): There is really no need to preanalyze
+	and resolve the triaged expression because all substitutions
+	refer to the proper entities.  Update the replacement of
+	references.
+	(Build_DIC_Procedure_Body): Add formal parameter
+	For_Freeze. Add local variable Build_Body. Inherited DIC pragmas
+	are now only processed when freezing occurs.  Build a body only
+	when one is needed.
+	(Entity_Hash): Removed.
+	(Map_Types): New routine.
+	(Replace_Object_And_Primitive_References): Removed.
+	(Replace_References): New routine.
+	(Replace_Type_References): Moved to the library level of Exp_Util.
+	(Type_Map_Hash): New routine.
+	(Update_Primitives_Mapping): Update the mapping call.
+	(Update_Primitives_Mapping_Of_Types): Removed.
+	* exp_util.ads (Build_DIC_Procedure_Body): Add formal
+	parameter For_Freeze and update the comment on usage.
+	(Map_Types): New routine.
+	(Replace_References): New routine.
+	(Replace_Type_References): Moved to the library level of Exp_Util.
+	(Update_Primitives_Mapping_Of_Types): Removed.
+	* sem_ch7.adb (Preserve_Full_Attributes): Propagate the DIC
+	properties of the private type to the full view in case the full
+	view derives from a parent type and inherits a DIC pragma.
+	* sem_prag.adb (Analyze_Pragma): Guard against a case where a
+	DIC pragma is placed at the top of a declarative region.
+
+2017-04-25  Arnaud Charlet  <charlet@adacore.com trojanek>
+
+	* a-tasatt.adb: Complete previous change and use an unsigned
+	int to avoid overflow checks.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Access): Specialize
+	the error message when the attribute reference is an actual in
+	a call to a subprogram inherited from a generic formal type with
+	unknown discriminants, which makes the subprogram and its formal
+	parameters intrinsic (see RM 6.3.1 (8) and (13)).
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* sem_aggr.adb, inline.adb, einfo.adb, einfo.ads, scng.adb,
 	sem_prag.adb: Minor reformatting.
 

gcc/ada/a-tasatt.adb

@@ -93,10 +93,11 @@ package body Ada.Task_Attributes is
    function To_Attribute is new
      Ada.Unchecked_Conversion (Atomic_Address, Attribute);
 
+   type Unsigned is mod 2 ** Integer'Size;
    function To_Address is new
      Ada.Unchecked_Conversion (Attribute, System.Address);
-   function To_Int is new
-     Ada.Unchecked_Conversion (Attribute, Integer);
+   function To_Unsigned is new
+     Ada.Unchecked_Conversion (Attribute, Unsigned);
 
    pragma Warnings (On);
 
@@ -121,7 +122,7 @@ package body Ada.Task_Attributes is
    Fast_Path : constant Boolean :=
                  (Attribute'Size = Integer'Size
                    and then Attribute'Alignment <= Atomic_Address'Alignment
-                   and then To_Int (Initial_Value) = 0)
+                   and then To_Unsigned (Initial_Value) = 0)
                  or else (Attribute'Size = System.Address'Size
                    and then Attribute'Alignment <= Atomic_Address'Alignment
                    and then To_Address (Initial_Value) = System.Null_Address);
@@ -303,7 +304,7 @@ package body Ada.Task_Attributes is
          --  No finalization needed, simply set to Val
 
          if Attribute'Size = Integer'Size then
-            TT.Attributes (Index) := Atomic_Address (To_Int (Val));
+            TT.Attributes (Index) := Atomic_Address (To_Unsigned (Val));
          else
             TT.Attributes (Index) := To_Address (Val);
          end if;

gcc/ada/elists.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -450,6 +450,17 @@ package body Elists is
       Elists.Table (To).First  := Elmts.Last;
    end Prepend_Elmt;
 
+   -------------------------
+   -- Prepend_Unique_Elmt --
+   -------------------------
+
+   procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id) is
+   begin
+      if not Contains (To, N) then
+         Prepend_Elmt (N, To);
+      end if;
+   end Prepend_Unique_Elmt;
+
    -------------
    -- Present --
    -------------

gcc/ada/elists.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, 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- --
@@ -141,6 +141,10 @@ package Elists is
    procedure Prepend_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
    --  Appends N at the beginning of To, allocating a new element
 
+   procedure Prepend_Unique_Elmt (N : Node_Or_Entity_Id; To : Elist_Id);
+   --  Like Prepend_Elmt, except that a check is made to see if To already
+   --  contains N and if so the call has no effect.
+
    procedure Insert_Elmt_After (N : Node_Or_Entity_Id; Elmt : Elmt_Id);
    --  Add a new element (N) right after the pre-existing element Elmt
    --  It is invalid to call this subprogram with Elmt = No_Elmt.

gcc/ada/exp_ch3.adb

@@ -7515,7 +7515,7 @@ package body Exp_Ch3 is
       --  verification of pragma Default_Initial_Condition's expression.
 
       if Has_DIC (Def_Id) then
-         Build_DIC_Procedure_Body (Def_Id);
+         Build_DIC_Procedure_Body (Def_Id, For_Freeze => True);
       end if;
 
       --  Generate the [spec and] body of the invariant procedure tasked with

gcc/ada/exp_util.ads

@@ -278,9 +278,13 @@ package Exp_Util is
    --  Build a call to the DIC procedure of type Typ with Obj_Id as the actual
    --  parameter.
 
-   procedure Build_DIC_Procedure_Body (Typ : Entity_Id);
+   procedure Build_DIC_Procedure_Body
+     (Typ        : Entity_Id;
+      For_Freeze : Boolean := False);
    --  Create the body of the procedure which verifies the assertion expression
-   --  of pragma Default_Initial_Condition at run time.
+   --  of pragma Default_Initial_Condition at run time. Flag For_Freeze should
+   --  be set when the body is construction as part of the freezing actions for
+   --  Typ.
 
    procedure Build_DIC_Procedure_Declaration (Typ : Entity_Id);
    --  Create the declaration of the procedure which verifies the assertion
@@ -870,6 +874,19 @@ package Exp_Util is
    --  wide type. Set Related_Id to request an external name for the subtype
    --  rather than an internal temporary.
 
+   procedure Map_Types (Parent_Type : Entity_Id; Derived_Type : Entity_Id);
+   --  Establish the following mapping between the attributes of tagged parent
+   --  type Parent_Type and tagged derived type Derived_Type.
+   --
+   --    * Map each discriminant of Parent_Type to ether the corresponding
+   --      discriminant of Derived_Type or come constraint.
+
+   --    * Map each primitive operation of Parent_Type to the corresponding
+   --      primitive of Derived_Type.
+   --
+   --  The mapping Parent_Type -> Derived_Type is also added to the table in
+   --  order to prevent subsequent attempts of the same mapping.
+
    function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id;
    --  Given a scalar subtype Typ, returns a matching type in standard that
    --  has the same object size value. For example, a 16 bit signed type will
@@ -995,6 +1012,37 @@ package Exp_Util is
    --  renaming cannot be elaborated without evaluating the subexpression, so
    --  gigi would resort to method 1) or 3) under the hood for them.
 
+   procedure Replace_References
+     (Expr      : Node_Id;
+      Par_Typ   : Entity_Id;
+      Deriv_Typ : Entity_Id;
+      Par_Obj   : Entity_Id := Empty;
+      Deriv_Obj : Entity_Id := Empty);
+   --  Expr denotes an arbitrary expression. Par_Typ is a tagged parent type
+   --  in a type hierarchy. Deriv_Typ is a tagged type derived from Par_Typ
+   --  with optional ancestors in between. Par_Obj is a formal parameter
+   --  which emulates the current instance of Par_Typ. Deriv_Obj is a formal
+   --  parameter which emulates the current instance of Deriv_Typ. Perform the
+   --  following substitutions in Expr:
+   --
+   --    * Replace a reference to Par_Obj with a reference to Deriv_Obj
+   --
+   --    * Replace a reference to a discriminant of Par_Typ with a suitable
+   --      value from the point of view of Deriv_Typ.
+   --
+   --    * Replace a call to an overridden primitive of Par_Typ with a call to
+   --      an overriding primitive of Deriv_Typ.
+   --
+   --    * Replace a call to an inherited primitive of Par_Type with a call to
+   --      the internally-generated inherited primitive of Deriv_Typ.
+
+   procedure Replace_Type_References
+     (Expr   : Node_Id;
+      Typ    : Entity_Id;
+      Obj_Id : Entity_Id);
+   --  Substitute all references of the current instance of type Typ with
+   --  references to formal parameter Obj_Id within expression Expr.
+
    function Represented_As_Scalar (T : Entity_Id) return Boolean;
    --  Returns True iff the implementation of this type in code generation
    --  terms is scalar. This is true for scalars in the Ada sense, and for
@@ -1103,12 +1151,6 @@ package Exp_Util is
    --  when elaborating a contract for a subprogram, and when freezing a type
    --  extension to verify legality rules on inherited conditions.
 
-   procedure Update_Primitives_Mapping_Of_Types
-     (Par_Typ   : Entity_Id;
-      Deriv_Typ : Entity_Id);
-   --  Map the primitive operations of parent type Par_Typ to the corresponding
-   --  primitives of derived type Deriv_Typ.
-
    function Within_Case_Or_If_Expression (N : Node_Id) return Boolean;
    --  Determine whether arbitrary node N is within a case or an if expression
 

gcc/ada/sem_attr.adb

@@ -10532,10 +10532,33 @@ package body Sem_Attr is
                   if Convention (Designated_Type (Btyp)) /=
                      Convention (Entity (P))
                   then
-                     Error_Msg_FE
-                       ("subprogram & has wrong convention", P, Entity (P));
-                     Error_Msg_Sloc := Sloc (Btyp);
-                     Error_Msg_FE ("\does not match & declared#", P, Btyp);
+                     --  The rule in 6.3.1 (8) deserves a special error
+                     --  message.
+
+                     if Convention (Btyp) = Convention_Intrinsic
+                       and then Nkind (Parent (N)) = N_Procedure_Call_Statement
+                       and then Is_Entity_Name (Name (Parent (N)))
+                       and then Inside_A_Generic
+                     then
+                        declare
+                           Subp : constant Entity_Id :=
+                                    Entity (Name (Parent (N)));
+                        begin
+                           if Convention (Subp) = Convention_Intrinsic then
+                              Error_Msg_FE ("subprogram and its formal "
+                              & "parameters have convention Intrinsic",
+                                Parent (N), Subp);
+                              Error_Msg_N
+                                ("actual cannot be access attribute", N);
+                           end if;
+                        end;
+
+                     else
+                        Error_Msg_FE
+                          ("subprogram & has wrong convention", P, Entity (P));
+                        Error_Msg_Sloc := Sloc (Btyp);
+                        Error_Msg_FE ("\does not match & declared#", P, Btyp);
+                     end if;
 
                      if not Is_Itype (Btyp)
                        and then not Has_Convention_Pragma (Btyp)

gcc/ada/sem_ch7.adb

@@ -2568,6 +2568,11 @@ package body Sem_Ch7 is
          Propagate_DIC_Attributes (Full, From_Typ => Full_Base);
          Propagate_DIC_Attributes (Full_Base, From_Typ => Full);
 
+         --  Propagate Default_Initial_Condition-related attributes from the
+         --  full view to the private view.
+
+         Propagate_DIC_Attributes (Priv, From_Typ => Full);
+
          --  Propagate invariant-related attributes from the base type of the
          --  full view to the full view and vice versa. This may seem strange,
          --  but is necessary depending on which type triggered the generation

gcc/ada/sem_prag.adb

@@ -13839,6 +13839,7 @@ package body Sem_Prag is
             Check_No_Identifiers;
             Check_At_Most_N_Arguments (1);
 
+            Typ  := Empty;
             Stmt := Prev (N);
             while Present (Stmt) loop
 
@@ -13880,6 +13881,14 @@ package body Sem_Prag is
                Stmt := Prev (Stmt);
             end loop;
 
+            --  The pragma does not apply to a legal construct, issue an error
+            --  and stop the analysis.
+
+            if No (Typ) then
+               Pragma_Misplaced;
+               return;
+            end if;
+
             --  A pragma that applies to a Ghost entity becomes Ghost for the
             --  purposes of legality checks and removal of ignored Ghost code.