[multiple changes]

2017-12-15  Bob Duff  <duff@adacore.com>

	* exp_ch6.adb (Expand_N_Extended_Return_Statement): If the
	Init_Assignment is rewritten, we need to set Assignment_OK on the new
	node.  Otherwise, we will get spurious errors when initializing via
	assignment statement.

2017-12-15  Arnaud Charlet  <charlet@adacore.com>

	* exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non
	relevant nodes.
	(Has_Non_Null_Statements): Moved to sem_util for later reuse.

2017-12-15  Eric Botcazou  <ebotcazou@adacore.com>

	* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment.
	* libgnat/s-fatgen.adb (Model): Use Machine attribute.
	(Truncation): Likewise.

2017-12-15  Bob Duff  <duff@adacore.com>

	* exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled
	statement sequence generated for certain extended return statements
	have a Sloc that is not No_Location. Otherwise, the back end doesn't
	set any location and ends up reading uninitialized variables.

From-SVN: r255680

8 files changed, 90 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 60f366c..9077056 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,31 @@
 2017-12-15  Bob Duff  <duff@adacore.com>
 
+	* exp_ch6.adb (Expand_N_Extended_Return_Statement): If the
+	Init_Assignment is rewritten, we need to set Assignment_OK on the new
+	node.  Otherwise, we will get spurious errors when initializing via
+	assignment statement.
+
+2017-12-15  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_unst.adb (Visit_Node): Refine handling of 'Access to ignore non
+	relevant nodes.
+	(Has_Non_Null_Statements): Moved to sem_util for later reuse.
+
+2017-12-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_attr.adb (Is_Inline_Floating_Point_Attribute): Fix comment.
+	* libgnat/s-fatgen.adb (Model): Use Machine attribute.
+	(Truncation): Likewise.
+
+2017-12-15  Bob Duff  <duff@adacore.com>
+
+	* exp_ch7.adb (Expand_Cleanup_Actions): Make sure the block and handled
+	statement sequence generated for certain extended return statements
+	have a Sloc that is not No_Location. Otherwise, the back end doesn't
+	set any location and ends up reading uninitialized variables.
+
+2017-12-15  Bob Duff  <duff@adacore.com>
+
 	* types.ads, exp_ch6.adb, libgnat/s-regexp.ads, opt.ads: Partly revert
 	r255414, committed by mistake.
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 79c6524..b181c1d 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8274,7 +8274,7 @@ package body Exp_Attr is
    --  Start of processing for Is_Inline_Floating_Point_Attribute
 
    begin
-      --  Machine and Model can be expanded by the GCC and AAMP back ends only
+      --  Machine and Model can be expanded by the GCC back end only
 
       if Id = Attribute_Machine or else Id = Attribute_Model then
          return Is_GCC_Target;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 8a3f390..43731c8 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5370,6 +5370,10 @@ package body Exp_Ch6 is
                         Rewrite (Name (Init_Assignment),
                           Make_Explicit_Dereference (Loc,
                             Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc)));
+                        pragma Assert
+                          (Assignment_OK
+                             (Original_Node (Name (Init_Assignment))));
+                        Set_Assignment_OK (Name (Init_Assignment));
 
                         Set_Etype (Name (Init_Assignment), Etype (Ret_Obj_Id));
 
@@ -7310,7 +7314,7 @@ package body Exp_Ch6 is
             begin
                --  ???For now, enable build-in-place for a very narrow set of
                --  controlled types. Change "if True" to "if False" to
-               --  experiment more controlled types. Eventually, we would
+               --  experiment with more controlled types. Eventually, we might
                --  like to enable build-in-place for all tagged types, all
                --  types that need finalization, and all caller-unknown-size
                --  types.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 1127875..4ce2ea1 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4310,20 +4310,6 @@ package body Exp_Ch7 is
          return;
       end if;
 
-      --  If we are generating expanded code for debugging purposes, use the
-      --  Sloc of the point of insertion for the cleanup code. The Sloc will be
-      --  updated subsequently to reference the proper line in .dg files. If we
-      --  are not debugging generated code, use No_Location instead, so that
-      --  no debug information is generated for the cleanup code. This makes
-      --  the behavior of the NEXT command in GDB monotonic, and makes the
-      --  placement of breakpoints more accurate.
-
-      if Debug_Generated_Code then
-         Loc := Sloc (Scop);
-      else
-         Loc := No_Location;
-      end if;
-
       --  If an extended return statement contains something like
       --     X := F (...);
       --  where F is a build-in-place function call returning a controlled
@@ -4350,13 +4336,13 @@ package body Exp_Ch7 is
       if Nkind (N) = N_Extended_Return_Statement then
          declare
             Block : constant Node_Id :=
-              Make_Block_Statement (Loc,
+              Make_Block_Statement (Sloc (N),
                Declarations => Empty_List,
                Handled_Statement_Sequence =>
                  Handled_Statement_Sequence (N));
          begin
             Set_Handled_Statement_Sequence
-              (N, Make_Handled_Sequence_Of_Statements (Loc,
+              (N, Make_Handled_Sequence_Of_Statements (Sloc (N),
                     Statements => New_List (Block)));
             Analyze (Block);
          end;
@@ -4380,6 +4366,20 @@ package body Exp_Ch7 is
          Old_Poll  : Boolean;
 
       begin
+         --  If we are generating expanded code for debugging purposes, use the
+         --  Sloc of the point of insertion for the cleanup code. The Sloc will
+         --  be updated subsequently to reference the proper line in .dg files.
+         --  If we are not debugging generated code, use No_Location instead,
+         --  so that no debug information is generated for the cleanup code.
+         --  This makes the behavior of the NEXT command in GDB monotonic, and
+         --  makes the placement of breakpoints more accurate.
+
+         if Debug_Generated_Code then
+            Loc := Sloc (Scop);
+         else
+            Loc := No_Location;
+         end if;
+
          --  Set polling off. The finalization and cleanup code is executed
          --  with aborts deferred.
 
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 9e5465b..558e986 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -586,18 +586,20 @@ package body Exp_Unst is
                         | Attribute_Unchecked_Access
                         | Attribute_Unrestricted_Access
                      =>
-                        Ent := Entity (Prefix (N));
+                        if Nkind (Prefix (N)) in N_Has_Entity then
+                           Ent := Entity (Prefix (N));
 
-                        --  We are only interested in calls to subprograms
-                        --  nested within Subp.
+                           --  We are only interested in calls to subprograms
+                           --  nested within Subp.
 
-                        if Scope_Within (Ent, Subp) then
-                           if Is_Imported (Ent) then
-                              null;
+                           if Scope_Within (Ent, Subp) then
+                              if Is_Imported (Ent) then
+                                 null;
 
-                           elsif Is_Subprogram (Ent) then
-                              Append_Unique_Call
-                                ((N, Current_Subprogram, Ent));
+                              elsif Is_Subprogram (Ent) then
+                                 Append_Unique_Call
+                                   ((N, Current_Subprogram, Ent));
+                              end if;
                            end if;
                         end if;
 
diff --git a/gcc/ada/libgnat/s-fatgen.adb b/gcc/ada/libgnat/s-fatgen.adb
index fdb34f2..f6dff9c 100644
--- a/gcc/ada/libgnat/s-fatgen.adb
+++ b/gcc/ada/libgnat/s-fatgen.adb
@@ -394,7 +394,7 @@ package body System.Fat_Gen is
 
    function Model (X : T) return T is
    begin
-      return Machine (X);
+      return T'Machine (X);
    end Model;
 
    ----------
@@ -739,10 +739,11 @@ package body System.Fat_Gen is
       Result := abs X;
 
       if Result >= Radix_To_M_Minus_1 then
-         return Machine (X);
+         return T'Machine (X);
 
       else
-         Result := Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
+         Result :=
+           T'Machine (Radix_To_M_Minus_1 + Result) - Radix_To_M_Minus_1;
 
          if Result > abs X then
             Result := Result - 1.0;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ea2379c..5bdbd5b 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -10619,6 +10619,30 @@ package body Sem_Util is
           and then Nkind (Node (First_Elmt (Constits))) /= N_Null;
    end Has_Non_Null_Refinement;
 
+   -----------------------------
+   -- Has_Non_Null_Statements --
+   -----------------------------
+
+   function Has_Non_Null_Statements (L : List_Id) return Boolean is
+      Node : Node_Id;
+
+   begin
+      if Is_Non_Empty_List (L) then
+         Node := First (L);
+
+         loop
+            if Nkind (Node) /= N_Null_Statement then
+               return True;
+            end if;
+
+            Next (Node);
+            exit when Node = Empty;
+         end loop;
+      end if;
+
+      return False;
+   end Has_Non_Null_Statements;
+
    ----------------------------------
    -- Has_Non_Trivial_Precondition --
    ----------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index c1f421f..e94515d 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1290,6 +1290,9 @@ package Sem_Util is
    --  in pragma Refined_State. This function does not take into account the
    --  visible refinement region of abstract state Id.
 
+   function Has_Non_Null_Statements (L : List_Id) return Boolean;
+   --  Return True if L has non-null statements
+
    function Has_Overriding_Initialize (T : Entity_Id) return Boolean;
    --  Predicate to determine whether a controlled type has a user-defined
    --  Initialize primitive (and, in Ada 2012, whether that primitive is