[multiple changes]

2017-01-13  Tristan Gingold  <gingold@adacore.com>

	* s-mmap.adb, s-mmap.ads (Open_Read_No_Exception): New function.
	(Open_Read): Re-implement using Open_Read_No_Exception.
	(Open_Write): Raise exception in case of error.
	* s-mmosin-mingw.adb (Open_Common): Do not raise exception.
	* s-mmosin-unix.adb (Open_Read, Open_Write): Do not
	reaise exception.
	* s-mmosin-mingw.ads, s-mmosin-unix.ads (Open_Read): Adjust comment.

2017-01-13  Yannick Moy  <moy@adacore.com>

	* checks.adb: Code cleanup.

2017-01-13  Yannick Moy  <moy@adacore.com>

	* freeze.adb (Check_Inherited_Conditions): Use analyzed pragma
	expression instead of unanalyzed aspect expression for checking
	the validity of inheriting an operation. Also copy the expression
	being passing it to Build_Class_Wide_Expression, as this call
	modifies its argument.
	* sem_util.ads Fix comment to reference correct function name
	New_Copy_Tree.

2017-01-13  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve_Generalized_Indexing): Compiling in ASIS mode,
	when we propagate information about the indexes back to the original
	indexing mode and the prefix of the index is a function call, do not
	remove any parameter from such call.

2017-01-13  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch6.ads (Needs_BIP_Finalization_Master): Update comment.
	* exp_ch6.adb (Needs_BIP_Finalization_Master): Return True for
	a build-in-place function whose result type is tagged.

2017-01-13  Yannick Moy  <moy@adacore.com>

	* sem_ch8.adb (Analyze_Subprogram_Renaming.Build_Class_Wide_Wrapper):
	Do not generate a wrapper when the only candidate is a class-wide
	subprogram.
	(Analyze_Subprogram_Renaming): Do not freeze the renaming or renamed
	inside a generic context.

From-SVN: r244399

gcc/ada/ChangeLog

+2017-01-13  Tristan Gingold  <gingold@adacore.com>
+
+	* s-mmap.adb, s-mmap.ads (Open_Read_No_Exception): New function.
+	(Open_Read): Re-implement using Open_Read_No_Exception.
+	(Open_Write): Raise exception in case of error.
+	* s-mmosin-mingw.adb (Open_Common): Do not raise exception.
+	* s-mmosin-unix.adb (Open_Read, Open_Write): Do not
+	reaise exception.
+	* s-mmosin-mingw.ads, s-mmosin-unix.ads (Open_Read): Adjust comment.
+
+2017-01-13  Yannick Moy  <moy@adacore.com>
+
+	* checks.adb: Code cleanup.
+
+2017-01-13  Yannick Moy  <moy@adacore.com>
+
+	* freeze.adb (Check_Inherited_Conditions): Use analyzed pragma
+	expression instead of unanalyzed aspect expression for checking
+	the validity of inheriting an operation. Also copy the expression
+	being passing it to Build_Class_Wide_Expression, as this call
+	modifies its argument.
+	* sem_util.ads Fix comment to reference correct function name
+	New_Copy_Tree.
+
+2017-01-13  Javier Miranda  <miranda@adacore.com>
+
+	* sem_res.adb (Resolve_Generalized_Indexing): Compiling in ASIS mode,
+	when we propagate information about the indexes back to the original
+	indexing mode and the prefix of the index is a function call, do not
+	remove any parameter from such call.
+
+2017-01-13  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch6.ads (Needs_BIP_Finalization_Master): Update comment.
+	* exp_ch6.adb (Needs_BIP_Finalization_Master): Return True for
+	a build-in-place function whose result type is tagged.
+
+2017-01-13  Yannick Moy  <moy@adacore.com>
+
+	* sem_ch8.adb (Analyze_Subprogram_Renaming.Build_Class_Wide_Wrapper):
+	Do not generate a wrapper when the only candidate is a class-wide
+	subprogram.
+	(Analyze_Subprogram_Renaming): Do not freeze the renaming or renamed
+	inside a generic context.
+
 2017-01-13  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* exp_util.adb (Add_Inherited_Tagged_DIC):

gcc/ada/checks.adb

@@ -337,6 +337,10 @@ package body Checks is
    --  Like Apply_Selected_Length_Checks, except it doesn't modify
    --  anything, just returns a list of nodes as described in the spec of
    --  this package for the Range_Check function.
+   --  ??? In fact it does construct the test and insert it into the tree,
+   --  and insert actions in various ways (calling Insert_Action directly
+   --  in particular) so we do not call it in GNATprove mode, contrary to
+   --  Selected_Range_Checks.
 
    function Selected_Range_Checks
      (Ck_Node    : Node_Id;
@@ -3085,25 +3089,18 @@ package body Checks is
           or else (not Length_Checks_Suppressed (Target_Typ));
 
    begin
-      --  Only apply checks when generating code. In GNATprove mode, we do
-      --  not apply the checks, but we still call Selected_Length_Checks to
-      --  possibly issue errors on SPARK code when a run-time error can be
-      --  detected at compile time.
+      --  Only apply checks when generating code
 
       --  Note: this means that we lose some useful warnings if the expander
       --  is not active.
 
-      if not Expander_Active and not GNATprove_Mode then
+      if not Expander_Active then
          return;
       end if;
 
       R_Result :=
         Selected_Length_Checks (Ck_Node, Target_Typ, Source_Typ, Empty);
 
-      if GNATprove_Mode then
-         return;
-      end if;
-
       for J in 1 .. 2 loop
          R_Cno := R_Result (J);
          exit when No (R_Cno);
@@ -9082,12 +9079,9 @@ package body Checks is
    --  Start of processing for Selected_Length_Checks
 
    begin
-      --  Checks will be applied only when generating code. In GNATprove mode,
-      --  we do not apply the checks, but we still call Selected_Length_Checks
-      --  to possibly issue errors on SPARK code when a run-time error can be
-      --  detected at compile time.
+      --  Checks will be applied only when generating code
 
-      if not Expander_Active and not GNATprove_Mode then
+      if not Expander_Active then
          return Ret_Result;
       end if;
 

gcc/ada/exp_ch6.adb

@@ -8378,9 +8378,20 @@ package body Exp_Ch6 is
       pragma Assert (Is_Build_In_Place_Function (Func_Id));
       Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
    begin
+      --  A formal giving the finalization master is needed for build-in-place
+      --  functions whose result type needs finalization or is a tagged type.
+      --  Tagged primitive build-in-place functions need such a formal because
+      --  they can be called by a dispatching call, and extensions may require
+      --  finalization even if the root type doesn't. This means they're also
+      --  needed for tagged nonprimitive build-in-place functions with tagged
+      --  results, since such functions can be called via access-to-function
+      --  types, and those can be used to call primitives, so masters have to
+      --  be passed to all such build-in-place functions, primitive or not.
+
       return
         not Restriction_Active (No_Finalization)
-          and then Needs_Finalization (Func_Typ);
+          and then (Needs_Finalization (Func_Typ)
+                     or else Is_Tagged_Type (Func_Typ));
    end Needs_BIP_Finalization_Master;
 
    --------------------------

gcc/ada/exp_ch6.ads

@@ -201,7 +201,9 @@ package Exp_Ch6 is
 
    function Needs_BIP_Finalization_Master (Func_Id : Entity_Id) return Boolean;
    --  Ada 2005 (AI-318-02): Return True if the result subtype of function
-   --  Func_Id needs finalization actions.
+   --  Func_Id might need finalization actions. This includes build-in-place
+   --  functions with tagged result types, since they can be invoked via
+   --  dispatching calls, and descendant types may require finalization.
 
    function Needs_Result_Accessibility_Level
      (Func_Id : Entity_Id) return Boolean;

gcc/ada/freeze.adb

@@ -1446,18 +1446,29 @@ package body Freeze is
          Prim := Node (Op_Node);
          if not Comes_From_Source (Prim) and then Present (Alias (Prim)) then
             Par_Prim := Alias (Prim);
-            A_Pre    := Find_Aspect (Par_Prim, Aspect_Pre);
+
+            --  Analyze the contract items of the parent operation, before
+            --  they are rewritten when inherited.
+
+            Analyze_Entry_Or_Subprogram_Contract (Par_Prim);
+
+            A_Pre := Get_Pragma (Par_Prim, Pragma_Precondition);
 
             if Present (A_Pre) and then Class_Present (A_Pre) then
+               A_Pre :=
+                 Expression (First (Pragma_Argument_Associations (A_Pre)));
                Build_Class_Wide_Expression
-                 (Expression (A_Pre), Prim, Par_Prim, Adjust_Sloc => False);
+                 (New_Copy_Tree (A_Pre), Prim, Par_Prim, Adjust_Sloc => False);
             end if;
 
-            A_Post := Find_Aspect (Par_Prim, Aspect_Post);
+            A_Post := Get_Pragma (Par_Prim, Pragma_Postcondition);
 
             if Present (A_Post) and then Class_Present (A_Post) then
+               A_Post :=
+                 Expression (First (Pragma_Argument_Associations (A_Post)));
                Build_Class_Wide_Expression
-                 (Expression (A_Post), Prim, Par_Prim, Adjust_Sloc => False);
+                 (New_Copy_Tree (A_Post),
+                  Prim, Par_Prim, Adjust_Sloc => False);
             end if;
          end if;
 

gcc/ada/s-mmap.adb

@@ -112,20 +112,43 @@ package body System.Mmap is
    procedure To_Disk (Region : Mapped_Region);
    --  Write the region of the file back to disk if necessary, and free memory
 
-   ---------------
-   -- Open_Read --
-   ---------------
+   ----------------------------
+   -- Open_Read_No_Exception --
+   ----------------------------
 
-   function Open_Read
+   function Open_Read_No_Exception
      (Filename              : String;
       Use_Mmap_If_Available : Boolean := True) return Mapped_File
    is
       File : constant System_File :=
          Open_Read (Filename, Use_Mmap_If_Available);
    begin
+      if File = Invalid_System_File then
+         return Invalid_Mapped_File;
+      end if;
+
       return new Mapped_File_Record'
         (Current_Region => Invalid_Mapped_Region,
          File           => File);
+   end Open_Read_No_Exception;
+
+   ---------------
+   -- Open_Read --
+   ---------------
+
+   function Open_Read
+     (Filename              : String;
+      Use_Mmap_If_Available : Boolean := True) return Mapped_File
+   is
+      Res : constant Mapped_File :=
+        Open_Read_No_Exception (Filename, Use_Mmap_If_Available);
+   begin
+      if Res = Invalid_Mapped_File then
+         raise Ada.IO_Exceptions.Name_Error
+           with "Cannot open " & Filename;
+      else
+         return Res;
+      end if;
    end Open_Read;
 
    ----------------
@@ -139,9 +162,14 @@ package body System.Mmap is
       File : constant System_File :=
          Open_Write (Filename, Use_Mmap_If_Available);
    begin
-      return new Mapped_File_Record'
-        (Current_Region => Invalid_Mapped_Region,
-         File           => File);
+      if File = Invalid_System_File then
+         raise Ada.IO_Exceptions.Name_Error
+           with "Cannot open " & Filename;
+      else
+         return new Mapped_File_Record'
+           (Current_Region => Invalid_Mapped_Region,
+            File           => File);
+      end if;
    end Open_Write;
 
    -----------

gcc/ada/s-mmap.ads

@@ -140,6 +140,11 @@ package System.Mmap is
    --  Name_Error is raised if the file does not exist.
    --  Filename should be compatible with the filesystem.
 
+   function Open_Read_No_Exception
+     (Filename              : String;
+      Use_Mmap_If_Available : Boolean := True) return Mapped_File;
+   --  Like Open_Read but return Invalid_Mapped_File in case of error
+
    function Open_Write
      (Filename              : String;
       Use_Mmap_If_Available : Boolean := True) return Mapped_File;

gcc/ada/s-mmosin-mingw.adb

@@ -32,6 +32,11 @@
 with Ada.IO_Exceptions;
 with System.Strings; use System.Strings;
 
+with System.OS_Lib;
+pragma Unreferenced (System.OS_Lib);
+--  Only used to generate same runtime dependencies and same binder file on
+--  GNU/Linux and Windows.
+
 package body System.Mmap.OS_Interface is
 
    use Win;
@@ -126,8 +131,7 @@ package body System.Mmap.OS_Interface is
          null, OPEN_EXISTING, Win.FILE_ATTRIBUTE_NORMAL, 0);
 
       if File_Handle = Win.INVALID_HANDLE_VALUE then
-         raise Ada.IO_Exceptions.Name_Error
-           with "Cannot open " & Filename;
+         return Invalid_System_File;
       end if;
 
       --  Compute its size
@@ -135,7 +139,7 @@ package body System.Mmap.OS_Interface is
       Size := File_Size (Win.GetFileSize (File_Handle, SizeH'Access));
 
       if Size = Win.INVALID_FILE_SIZE then
-         raise Ada.IO_Exceptions.Use_Error;
+         return Invalid_System_File;
       end if;
 
       if SizeH /= 0 and then File_Size'Size > 32 then

gcc/ada/s-mmosin-mingw.ads

@@ -191,8 +191,8 @@ package System.Mmap.OS_Interface is
    function Open_Read
      (Filename              : String;
       Use_Mmap_If_Available : Boolean := True) return System_File;
-   --  Open a file for reading and return the corresponding System_File. Raise
-   --  a Ada.IO_Exceptions.Name_Error if unsuccessful.
+   --  Open a file for reading and return the corresponding System_File. Return
+   --  Invalid_System_File if unsuccessful.
 
    function Open_Write
      (Filename              : String;

gcc/ada/s-mmosin-unix.adb

@@ -57,8 +57,7 @@ package body System.Mmap.OS_Interface is
         Open_Read (Filename, Binary);
    begin
       if Fd = Invalid_FD then
-         raise Ada.IO_Exceptions.Name_Error
-           with "Cannot open " & Filename;
+         return Invalid_System_File;
       end if;
       return
         (Fd     => Fd,
@@ -78,8 +77,7 @@ package body System.Mmap.OS_Interface is
         Open_Read_Write (Filename, Binary);
    begin
       if Fd = Invalid_FD then
-         raise Ada.IO_Exceptions.Name_Error
-         with "Cannot open " & Filename;
+         return Invalid_System_File;
       end if;
       return
         (Fd     => Fd,

gcc/ada/s-mmosin-unix.ads

@@ -61,8 +61,8 @@ package System.Mmap.OS_Interface is
    function Open_Read
      (Filename              : String;
       Use_Mmap_If_Available : Boolean := True) return System_File;
-   --  Open a file for reading and return the corresponding System_File. Raise
-   --  a Ada.IO_Exceptions.Name_Error if unsuccessful.
+   --  Open a file for reading and return the corresponding System_File. Return
+   --  Invalid_System_File if unsuccessful.
 
    function Open_Write
      (Filename              : String;

gcc/ada/sem_ch8.adb

@@ -1888,8 +1888,10 @@ package body Sem_Ch8 is
       --
       --  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
-      --  the generated class-wide wrapper (or Any_Id).
+      --  the entity of the renaming declaration. When the transformation
+      --  applies, Wrap_Id is the entity of the generated class-wide wrapper
+      --  (or Any_Id). Otherwise, Wrap_Id is the entity of the class-wide
+      --  operation.
 
       procedure Check_Null_Exclusion
         (Ren : Entity_Id;
@@ -2372,6 +2374,16 @@ package body Sem_Ch8 is
          Set_Is_Overloaded (Name (N), False);
          Set_Referenced    (Prim_Op);
 
+         --  Do not generate a wrapper when the only candidate is a class-wide
+         --  subprogram. Instead modify the renaming to directly map the actual
+         --  to the generic formal.
+
+         if CW_Prim_OK and then Prim_Op = CW_Prim_Op then
+            Wrap_Id := Prim_Op;
+            Rewrite (Nam, New_Occurrence_Of (Prim_Op, Loc));
+            return;
+         end if;
+
          --  Step 3: Create the declaration and the body of the wrapper, insert
          --  all the pieces into the tree.
 
@@ -3391,7 +3403,12 @@ package body Sem_Ch8 is
             Set_Alias (New_S, Empty);
          end if;
 
-         if Is_Actual then
+         --  Do not freeze the renaming nor the renamed entity when the context
+         --  is an enclosing generic. Freezing is an expansion activity, and in
+         --  addition the renamed entity may depend on the generic formals of
+         --  the enclosing generic.
+
+         if Is_Actual and not Inside_A_Generic then
             Freeze_Before (N, Old_S);
             Freeze_Actual_Profile;
             Set_Has_Delayed_Freeze (New_S, False);

gcc/ada/sem_res.adb

@@ -8112,7 +8112,7 @@ package body Sem_Res is
          end loop;
 
          if Nkind (Call) = N_Function_Call then
-            Indexes := Parameter_Associations (Call);
+            Indexes := New_Copy_List (Parameter_Associations (Call));
             Pref := Remove_Head (Indexes);
             Set_Expressions (N, Indexes);
 

gcc/ada/sem_util.ads

@@ -1849,21 +1849,21 @@ package Sem_Util is
       Map       : Elist_Id   := No_Elist;
       New_Sloc  : Source_Ptr := No_Location;
       New_Scope : Entity_Id  := Empty) return Node_Id;
-   --  Given a node that is the root of a subtree, Copy_Tree copies the entire
-   --  syntactic subtree, including recursively any descendants whose parent
-   --  field references a copied node (descendants not linked to a copied node
-   --  by the parent field are not copied, instead the copied tree references
-   --  the same descendant as the original in this case, which is appropriate
-   --  for non-syntactic fields such as Etype). The parent pointers in the
-   --  copy are properly set. Copy_Tree (Empty/Error) returns Empty/Error.
-   --  The one exception to the rule of not copying semantic fields is that
-   --  any implicit types attached to the subtree are duplicated, so that
-   --  the copy contains a distinct set of implicit type entities. Thus this
-   --  function is used when it is necessary to duplicate an analyzed tree,
-   --  declared in the same or some other compilation unit. This function is
-   --  declared here rather than in atree because it uses semantic information
-   --  in particular concerning the structure of itypes and the generation of
-   --  public symbols.
+   --  Given a node that is the root of a subtree, New_Copy_Tree copies the
+   --  entire syntactic subtree, including recursively any descendants whose
+   --  parent field references a copied node (descendants not linked to a
+   --  copied node by the parent field are not copied, instead the copied tree
+   --  references the same descendant as the original in this case, which is
+   --  appropriate for non-syntactic fields such as Etype). The parent pointers
+   --  in the copy are properly set. New_Copy_Tree (Empty/Error) returns
+   --  Empty/Error. The one exception to the rule of not copying semantic
+   --  fields is that any implicit types attached to the subtree are
+   --  duplicated, so that the copy contains a distinct set of implicit type
+   --  entities. Thus this function is used when it is necessary to duplicate
+   --  an analyzed tree, declared in the same or some other compilation unit.
+   --  This function is declared here rather than in atree because it uses
+   --  semantic information in particular concerning the structure of itypes
+   --  and the generation of public symbols.
 
    --  The Map argument, if set to a non-empty Elist, specifies a set of
    --  mappings to be applied to entities in the tree. The map has the form: