[multiple changes]

2017-04-25  Tristan Gingold  <gingold@adacore.com>

	* s-mmap.ads (Data): Add pragma Inline.

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

	* checks.adb (Insert_Valid_Check): Do not use
	a renaming to alias a volatile name because this will lead to
	multiple evaluations of the volatile name. Use a constant to
	capture the value instead.

2017-04-25  Doug Rupp  <rupp@adacore.com>

	* init.c [VxWorks Section]: Disable sigtramp for ppc64-vx7.

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

	* exp_util.adb, exp_util.ads (Build_Class_Wide_Expression):
	Add out parameter to indicate to caller that a wrapper must
	be constructed for an inherited primitive whose inherited
	pre/postcondition has called to overridden primitives.
	* freeze.adb (Check_Inherited_Conditions): Build wrapper body
	for inherited primitive that requires it.
	* sem_disp.adb (Check_Dispatching_Operation): Such wrappers are
	legal primitive operations and belong to the list of bodies
	generated after the freeze point of a type.
	* sem_prag.adb (Build_Pragma_Check_Equivalent): Use new signature
	of Build_Class_Wide_Expression.
	* sem_util.adb, sem_util.ads (Build_Overriding_Spec): New procedure
	to construct the specification of the wrapper subprogram created
	for an inherited operation.

From-SVN: r247140

gcc/ada/ChangeLog

+2017-04-25  Tristan Gingold  <gingold@adacore.com>
+
+	* s-mmap.ads (Data): Add pragma Inline.
+
+2017-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* checks.adb (Insert_Valid_Check): Do not use
+	a renaming to alias a volatile name because this will lead to
+	multiple evaluations of the volatile name. Use a constant to
+	capture the value instead.
+
+2017-04-25  Doug Rupp  <rupp@adacore.com>
+
+	* init.c [VxWorks Section]: Disable sigtramp for ppc64-vx7.
+
+2017-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_util.adb, exp_util.ads (Build_Class_Wide_Expression):
+	Add out parameter to indicate to caller that a wrapper must
+	be constructed for an inherited primitive whose inherited
+	pre/postcondition has called to overridden primitives.
+	* freeze.adb (Check_Inherited_Conditions): Build wrapper body
+	for inherited primitive that requires it.
+	* sem_disp.adb (Check_Dispatching_Operation): Such wrappers are
+	legal primitive operations and belong to the list of bodies
+	generated after the freeze point of a type.
+	* sem_prag.adb (Build_Pragma_Check_Equivalent): Use new signature
+	of Build_Class_Wide_Expression.
+	* sem_util.adb, sem_util.ads (Build_Overriding_Spec): New procedure
+	to construct the specification of the wrapper subprogram created
+	for an inherited operation.
+
 2017-04-25  Bob Duff  <duff@adacore.com>
 
 	* s-osinte-linux.ads (pthread_mutexattr_setprotocol,

gcc/ada/checks.adb

@@ -7210,17 +7210,18 @@ package body Checks is
          end if;
 
          --  Build the prefix for the 'Valid call. If the expression denotes
-         --  a name, use a renaming to alias it, otherwise use a constant to
-         --  capture the value of the expression.
+         --  a non-volatile name, use a renaming to alias it, otherwise use a
+         --  constant to capture the value of the expression.
 
-         --    Temp : ... renames Expr;      --  reference to a name
+         --    Temp : ... renames Expr;      --  non-volatile name
          --    Temp : constant ... := Expr;  --  all other cases
 
          PV :=
            Duplicate_Subexpr_No_Checks
              (Exp           => Exp,
               Name_Req      => False,
-              Renaming_Req  => Is_Name_Reference (Exp),
+              Renaming_Req  =>
+                Is_Name_Reference (Exp) and then not Is_Volatile (Typ),
               Related_Id    => Related_Id,
               Is_Low_Bound  => Is_Low_Bound,
               Is_High_Bound => Is_High_Bound);

gcc/ada/exp_util.adb

@@ -1041,11 +1041,13 @@ package body Exp_Util is
    ---------------------------------
 
    procedure Build_Class_Wide_Expression
-     (Prag        : Node_Id;
-      Subp        : Entity_Id;
-      Par_Subp    : Entity_Id;
-      Adjust_Sloc : Boolean)
+     (Prag          : Node_Id;
+      Subp          : Entity_Id;
+      Par_Subp      : Entity_Id;
+      Adjust_Sloc   : Boolean;
+      Needs_Wrapper : out Boolean)
    is
+
       function Replace_Entity (N : Node_Id) return Traverse_Result;
       --  Replace reference to formal of inherited operation or to primitive
       --  operation of root type, with corresponding entity for derived type,
@@ -1089,6 +1091,13 @@ package body Exp_Util is
 
             if Present (New_E) then
                Rewrite (N, New_Occurrence_Of (New_E, Sloc (N)));
+
+               --  If the entity is an overridden primitive, we must build
+               --  a wrapper for the current inherited operation.
+
+               if Is_Subprogram (New_E) then
+                  Needs_Wrapper := True;
+               end if;
             end if;
 
             --  Check that there are no calls left to abstract operations if
@@ -1156,6 +1165,8 @@ package body Exp_Util is
    --  Start of processing for Build_Class_Wide_Expression
 
    begin
+      Needs_Wrapper := False;
+
       --  Add mapping from old formals to new formals
 
       Par_Formal  := First_Formal (Par_Subp);

gcc/ada/exp_util.ads

@@ -248,10 +248,11 @@ package Exp_Util is
    --  not install a call to Abort_Defer.
 
    procedure Build_Class_Wide_Expression
-     (Prag        : Node_Id;
-      Subp        : Entity_Id;
-      Par_Subp    : Entity_Id;
-      Adjust_Sloc : Boolean);
+     (Prag          : Node_Id;
+      Subp          : Entity_Id;
+      Par_Subp      : Entity_Id;
+      Adjust_Sloc   : Boolean;
+      Needs_Wrapper : out Boolean);
    --  Build the expression for an inherited class-wide condition. Prag is
    --  the pragma constructed from the corresponding aspect of the parent
    --  subprogram, and Subp is the overriding operation, and Par_Subp is
@@ -264,6 +265,11 @@ package Exp_Util is
    --  is the expression of the original class-wide aspect. In SPARK_Mode, such
    --  operation which are just inherited but have modified pre/postconditions
    --  are illegal.
+   --  If there are calls to overridden operations in the condition, and the
+   --  pragma applies to an inherited operation, a wrapper must be built for
+   --  it to capture the new inherited condition. The flag Needs_Wrapper is
+   --  set in that case so that the wrapper can be built, when the controlling
+   --  type is frozen.
 
    function Build_DIC_Call
      (Loc    : Source_Ptr;

gcc/ada/freeze.adb

@@ -55,6 +55,7 @@ with Sem_Ch6;   use Sem_Ch6;
 with Sem_Ch7;   use Sem_Ch7;
 with Sem_Ch8;   use Sem_Ch8;
 with Sem_Ch13;  use Sem_Ch13;
+with Sem_Disp;  use Sem_Disp;
 with Sem_Eval;  use Sem_Eval;
 with Sem_Mech;  use Sem_Mech;
 with Sem_Prag;  use Sem_Prag;
@@ -1395,17 +1396,22 @@ package body Freeze is
    --------------------------------
 
    procedure Check_Inherited_Conditions (R : Entity_Id) is
-      Prim_Ops : constant Elist_Id := Primitive_Operations (R);
-      A_Post   : Node_Id;
-      A_Pre    : Node_Id;
-      Op_Node  : Elmt_Id;
-      Par_Prim : Entity_Id;
-      Prim     : Entity_Id;
+      Prim_Ops      : constant Elist_Id := Primitive_Operations (R);
+      A_Post        : Node_Id;
+      A_Pre         : Node_Id;
+      Decls         : List_Id;
+      Op_Node       : Elmt_Id;
+      Par_Prim      : Entity_Id;
+      Par_Type      : Entity_Id;
+      New_Prag      : Node_Id;
+      Prim          : Entity_Id;
+      Needs_Wrapper : Boolean;
 
    begin
       Op_Node := First_Elmt (Prim_Ops);
       while Present (Op_Node) loop
-         Prim := Node (Op_Node);
+         Prim          := Node (Op_Node);
+         Needs_Wrapper := False;
 
          --  Map the overridden primitive to the overriding one. This takes
          --  care of all overridings and is done only once.
@@ -1446,9 +1452,12 @@ package body Freeze is
 
       Op_Node := First_Elmt (Prim_Ops);
       while Present (Op_Node) loop
-         Prim := Node (Op_Node);
+         Decls := Empty_List;
+         Prim  := Node (Op_Node);
+
          if not Comes_From_Source (Prim) and then Present (Alias (Prim)) then
             Par_Prim := Alias (Prim);
+            Par_Type := Find_Dispatching_Type (Par_Prim);
 
             --  Analyze the contract items of the parent operation, before
             --  they are rewritten when inherited.
@@ -1458,24 +1467,116 @@ package body Freeze is
             A_Pre := Get_Pragma (Par_Prim, Pragma_Precondition);
 
             if Present (A_Pre) and then Class_Present (A_Pre) then
+               New_Prag := New_Copy_Tree (A_Pre);
                Build_Class_Wide_Expression
-                 (Prag        => New_Copy_Tree (A_Pre),
-                  Subp        => Prim,
-                  Par_Subp    => Par_Prim,
-                  Adjust_Sloc => False);
+                 (Prag          => New_Prag,
+                  Subp          => Prim,
+                  Par_Subp      => Par_Prim,
+                  Adjust_Sloc   => False,
+                  Needs_Wrapper => Needs_Wrapper);
+
+               if Needs_Wrapper then
+                  Append (New_Prag, Decls);
+               end if;
             end if;
 
             A_Post := Get_Pragma (Par_Prim, Pragma_Postcondition);
 
             if Present (A_Post) and then Class_Present (A_Post) then
+               New_Prag := New_Copy_Tree (A_Pre);
                Build_Class_Wide_Expression
-                 (Prag        => New_Copy_Tree (A_Post),
-                  Subp        => Prim,
-                  Par_Subp    => Par_Prim,
-                  Adjust_Sloc => False);
+                 (Prag           => New_Prag,
+                  Subp           => Prim,
+                  Par_Subp       => Par_Prim,
+                  Adjust_Sloc    => False,
+                  Needs_Wrapper  => Needs_Wrapper);
+
+               if Needs_Wrapper then
+                  Append (New_Prag, Decls);
+               end if;
             end if;
          end if;
 
+         if Needs_Wrapper and then not Is_Abstract_Subprogram (Par_Prim) then
+
+            --  We need to build a new primitive that overrides the inherited
+            --  one, and whose inherited expression has been updated above.
+            --  These expressions are the arguments of pragmas that are part
+            --  of the declarations of the wrapper. The wrapper holds a single
+            --  statement that is a call to the parent primitive, where the
+            --  controlling actuals are conversions to the corresponding type
+            --  in the parent primitive:
+
+            --  procedure New_Prim (F1 : T1.; ...) is
+            --     pragma Check (Precondition,  Expr);
+            --  begin
+            --     Par_Prim (Par_Type (F1) ..);
+            --  end;
+            --
+            --  If the primitive is a function the statement is a call.
+
+            declare
+               Loc        : constant Source_Ptr := Sloc (R);
+               Formal     : Entity_Id;
+               Actuals    : List_Id;
+               New_F_Spec : Node_Id;
+               New_Formal : Entity_Id;
+               New_Proc   : Node_Id;
+               New_Spec   : Node_Id;
+               Call       : Node_Id;
+
+            begin
+               Actuals  := Empty_List;
+               New_Spec := Build_Overriding_Spec (Par_Prim, R);
+               Formal     := First_Formal (Par_Prim);
+               New_F_Spec := First (Parameter_Specifications (New_Spec));
+
+               while Present (Formal) loop
+                  New_Formal := Defining_Identifier (New_F_Spec);
+
+                  --  If controlling argument, add conversion.
+
+                  if Etype (Formal) = Par_Type then
+                     Append_To (Actuals,
+                       Make_Type_Conversion (Loc,
+                         New_Occurrence_Of (Par_Type, Loc),
+                         New_Occurrence_Of (New_Formal, Loc)));
+
+                  else
+                     Append_To (Actuals, New_Occurrence_Of (New_Formal, Loc));
+                  end if;
+
+                  Next_Formal (Formal);
+                  Next (New_F_Spec);
+               end loop;
+
+               if Ekind (Par_Prim) = E_Procedure then
+                  Call := Make_Procedure_Call_Statement (Loc,
+                    Parameter_Associations => Actuals,
+                    Name => New_Occurrence_Of (Par_Prim, Loc));
+               else
+                  Call := Make_Simple_Return_Statement (Loc,
+                     Expression =>
+                       Make_Function_Call (Loc,
+                         Parameter_Associations => Actuals,
+                      Name => New_Occurrence_Of (Par_Prim, Loc)));
+               end if;
+
+               New_Proc := Make_Subprogram_Body (Loc,
+                Specification              => New_Spec,
+                Declarations               => Decls,
+                Handled_Statement_Sequence =>
+                  Make_Handled_Sequence_Of_Statements (Loc,
+                    Statements => New_List (Call),
+                    End_Label  => Make_Identifier (Loc, Chars (Prim))));
+
+               Insert_After (Parent (R), New_Proc);
+               Analyze (New_Proc);
+            end;
+
+            Needs_Wrapper := False;
+         end if;
+
          Next_Elmt (Op_Node);
       end loop;
    end Check_Inherited_Conditions;

gcc/ada/init.c

@@ -2005,7 +2005,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc)
   sigdelset (&mask, sig);
   sigprocmask (SIG_SETMASK, &mask, NULL);
 
-#if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__) || defined (__x86_64__)
+#if defined (__ARMEL__) || (defined (__PPC__) && !defined (__PPC64__)) || defined (__i386__) || defined (__x86_64__)
   /* On certain targets, kernel mode, we process signals through a Call Frame
      Info trampoline, voiding the need for myriads of fallback_frame_state
      variants in the ZCX runtime.  We have no simple way to distinguish ZCX

gcc/ada/s-mmap.ads

@@ -223,11 +223,13 @@ package System.Mmap is
    --  (File); such accesses may cause Storage_Error to be raised.
 
    function Data (Region : Mapped_Region) return Str_Access;
+   pragma Inline (Data);
    --  The data mapped in Region as requested. The result is an unconstrained
    --  string, so you cannot use the usual 'First and 'Last attributes.
    --  Instead, these are respectively 1 and Size.
 
    function Data (File : Mapped_File) return Str_Access;
+   pragma Inline (Data);
    --  Likewise for the region contained in File
 
    function Is_Mutable (Region : Mapped_Region) return Boolean;

gcc/ada/sem_disp.adb

@@ -1090,6 +1090,11 @@ package body Sem_Disp is
          --  3. Subprograms associated with stream attributes (built by
          --     New_Stream_Subprogram)
 
+         --  4. Wrapper built for inherited operations with inherited class-
+         --     wide conditions, where the conditions include calls to other
+         --     overridden primitives. The wrappers include checks on these
+         --     modified conditions. (AI12-113).
+
          if Present (Old_Subp)
            and then Present (Overridden_Operation (Subp))
            and then Is_Dispatching_Operation (Old_Subp)
@@ -1098,14 +1103,18 @@ package body Sem_Disp is
               ((Ekind (Subp) = E_Function
                  and then Is_Dispatching_Operation (Old_Subp)
                  and then Is_Null_Extension (Base_Type (Etype (Subp))))
+
               or else
                (Ekind (Subp) = E_Procedure
                  and then Is_Dispatching_Operation (Old_Subp)
                  and then Present (Alias (Old_Subp))
                  and then Is_Null_Interface_Primitive
                              (Ultimate_Alias (Old_Subp)))
+
               or else Get_TSS_Name (Subp) = TSS_Stream_Read
-              or else Get_TSS_Name (Subp) = TSS_Stream_Write);
+              or else Get_TSS_Name (Subp) = TSS_Stream_Write
+
+              or else Present (Contract (Overridden_Operation (Subp))));
 
             Check_Controlling_Formals (Tagged_Type, Subp);
             Override_Dispatching_Operation (Tagged_Type, Old_Subp, Subp);

gcc/ada/sem_prag.adb

@@ -27017,6 +27017,9 @@ package body Sem_Prag is
       Inher_Id       : Entity_Id := Empty;
       Keep_Pragma_Id : Boolean := False) return Node_Id
    is
+      Needs_Wrapper : Boolean;
+      pragma Unreferenced (Needs_Wrapper);
+
       function Suppress_Reference (N : Node_Id) return Traverse_Result;
       --  Detect whether node N references a formal parameter subject to
       --  pragma Unreferenced. If this is the case, set Comes_From_Source
@@ -27085,7 +27088,8 @@ package body Sem_Prag is
          --  Build the inherited class-wide condition
 
          Build_Class_Wide_Expression
-           (Check_Prag, Subp_Id, Inher_Id, Adjust_Sloc => True);
+           (Check_Prag, Subp_Id, Inher_Id, Adjust_Sloc => True,
+             Needs_Wrapper =>  Needs_Wrapper);
 
       --  If not an inherited condition simply copy the original pragma
 

gcc/ada/sem_util.adb

@@ -1581,6 +1581,40 @@ package body Sem_Util is
       Set_Etype (Expr, Designated_Type (Etype (Disc)));
    end Build_Explicit_Dereference;
 
+   ---------------------------
+   -- Build_Overriding_Spec --
+   ---------------------------
+
+   function Build_Overriding_Spec
+     (Op  : Entity_Id;
+      Typ : Entity_Id) return Node_Id
+   is
+      Loc     : constant Source_Ptr := Sloc (Typ);
+      Par_Typ : constant Entity_Id := Find_Dispatching_Type (Op);
+      Spec    : constant Node_Id := Specification (Unit_Declaration_Node (Op));
+
+      Formal_Spec : Node_Id;
+      Formal_Type : Node_Id;
+      New_Spec    : Node_Id;
+   begin
+      New_Spec := Copy_Subprogram_Spec (Spec);
+      Formal_Spec := First (Parameter_Specifications (New_Spec));
+      while Present (Formal_Spec) loop
+         Formal_Type := Parameter_Type (Formal_Spec);
+         if Is_Entity_Name (Formal_Type)
+           and then Entity (Formal_Type) = Par_Typ
+         then
+            Rewrite (Formal_Type, New_Occurrence_Of (Typ, Loc));
+         end if;
+
+         --  Nothing needs to be done for access parameters.
+
+         Next (Formal_Spec);
+      end loop;
+
+      return New_Spec;
+   end Build_Overriding_Spec;
+
    -----------------------------------
    -- Cannot_Raise_Constraint_Error --
    -----------------------------------

gcc/ada/sem_util.ads

@@ -227,6 +227,14 @@ package Sem_Util is
    --  the compilation unit, and install it in the Elaboration_Entity field
    --  of Spec_Id, the entity for the compilation unit.
 
+   function Build_Overriding_Spec
+     (Op  : Node_Id;
+      Typ : Entity_Id) return Node_Id;
+   --  Build a subprogram specification for the wrapper of an inherited
+   --  operation with a modified pre- or postcondition (See AI12-0113).
+   --  Op is the parent operation, and Typ is the descendant type that
+   --  inherits the operation.
+
    procedure Build_Explicit_Dereference
      (Expr : Node_Id;
       Disc : Entity_Id);