[multiple changes]

2015-10-23  Arnaud Charlet  <charlet@adacore.com>

	* exp_unst.adb (Unnest_Subprogram): Complete previous
	change and update comments.

2015-10-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.ads, sem_util.adb (Check_Function_With_Address_Parameter):
	A subprogram that has an Address parameter and is declared in a Pure
	package is not considered Pure, because the parameter may be used as a
	pointer and the referenced data may change even if the address value
	itself does not.
	* freeze.adb (Freeze_Subprogram): use it.
	* exp_ch6.adb (Expand_N_Subprogram_Body): Use it.

From-SVN: r229234

6 files changed, 94 insertions, 49 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b811165..8fa3e22 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2015-10-23  Arnaud Charlet  <charlet@adacore.com>
+
+	* exp_unst.adb (Unnest_Subprogram): Complete previous
+	change and update comments.
+
+2015-10-23  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.ads, sem_util.adb (Check_Function_With_Address_Parameter):
+	A subprogram that has an Address parameter and is declared in a Pure
+	package is not considered Pure, because the parameter may be used as a
+	pointer and the referenced data may change even if the address value
+	itself does not.
+	* freeze.adb (Freeze_Subprogram): use it.
+	* exp_ch6.adb (Expand_N_Subprogram_Body): Use it.
+
 2015-10-23  Olivier Hainque  <hainque@adacore.com>
 
 	* tracebak.c: Fallback to generic unwinder for gcc-sjlj on x86 &
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 31267a5..407ecef 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5035,6 +5035,23 @@ package body Exp_Ch6 is
          Spec_Id := Body_Id;
       end if;
 
+      --  If this is a Pure function which has any parameters whose root type
+      --  is System.Address, reset the Pure indication.
+      --  This check is also performed when the subprogram is frozen, but we
+      --  repeat it on the body so that the indication is consistent, and so
+      --  it applies as well to bodies without separate specifications.
+
+      if Is_Pure (Spec_Id)
+        and then Is_Subprogram (Spec_Id)
+        and then not Has_Pragma_Pure_Function (Spec_Id)
+      then
+         Check_Function_With_Address_Parameter (Spec_Id);
+
+         if Spec_Id /= Body_Id then
+            Set_Is_Pure (Body_Id, Is_Pure (Spec_Id));
+         end if;
+      end if;
+
       --  The subprogram body is Ghost when it is stand alone and subject to
       --  pragma Ghost or the corresponding spec is Ghost. To accomodate both
       --  cases, set the mode now to ensure that any nodes generated during
@@ -5113,51 +5130,6 @@ package body Exp_Ch6 is
          end if;
       end if;
 
-      --  If this is a Pure function which has any parameters whose root type
-      --  is System.Address, reset the Pure indication, since it will likely
-      --  cause incorrect code to be generated as the parameter is probably
-      --  a pointer, and the fact that the same pointer is passed does not mean
-      --  that the same value is being referenced.
-
-      --  Note that if the programmer gave an explicit Pure_Function pragma,
-      --  then we believe the programmer, and leave the subprogram Pure.
-
-      --  This code should probably be at the freeze point, so that it happens
-      --  even on a -gnatc (or more importantly -gnatt) compile, so that the
-      --  semantic tree has Is_Pure set properly ???
-
-      if Is_Pure (Spec_Id)
-        and then Is_Subprogram (Spec_Id)
-        and then not Has_Pragma_Pure_Function (Spec_Id)
-      then
-         declare
-            F : Entity_Id;
-
-         begin
-            F := First_Formal (Spec_Id);
-            while Present (F) loop
-               if Is_Descendent_Of_Address (Etype (F))
-
-                 --  Note that this test is being made in the body of the
-                 --  subprogram, not the spec, so we are testing the full
-                 --  type for being limited here, as required.
-
-                 or else Is_Limited_Type (Etype (F))
-               then
-                  Set_Is_Pure (Spec_Id, False);
-
-                  if Spec_Id /= Body_Id then
-                     Set_Is_Pure (Body_Id, False);
-                  end if;
-
-                  exit;
-               end if;
-
-               Next_Formal (F);
-            end loop;
-         end;
-      end if;
-
       --  Initialize any scalar OUT args if Initialize/Normalize_Scalars
 
       if Init_Or_Norm_Scalars and then Is_Subprogram (Spec_Id) then
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 238261e..bbd11f9 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -1261,15 +1261,20 @@ package body Exp_Unst is
 
                      Push_Scope (STJ.Ent);
                      Analyze (Decl_ARECnT,  Suppress => All_Checks);
+
+                     --  Note that we need to call Set_Suppress_Initialization
+                     --  after Decl_ARECnT has been analyzed, but before
+                     --  analyzing Decl_ARECnP so that the flag is properly
+                     --  taking into account.
+
+                     Set_Suppress_Initialization (STJ.ARECnT);
+
                      Analyze (Decl_ARECnPT, Suppress => All_Checks);
                      Analyze (Decl_ARECn,   Suppress => All_Checks);
                      Analyze (Decl_ARECnP,  Suppress => All_Checks);
 
-                     Set_Suppress_Initialization
-                       (Defining_Identifier (Decl_ARECnT));
-
                      if Present (Decl_Assign) then
-                        Analyze (Decl_Assign,  Suppress => All_Checks);
+                        Analyze (Decl_Assign, Suppress => All_Checks);
                      end if;
 
                      Pop_Scope;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index ee8a23e..91ff7a0 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -36,6 +36,7 @@ with Exp_Disp; use Exp_Disp;
 with Exp_Pakd; use Exp_Pakd;
 with Exp_Util; use Exp_Util;
 with Exp_Tss;  use Exp_Tss;
+with Fname;    use Fname;
 with Ghost;    use Ghost;
 with Layout;   use Layout;
 with Lib;      use Lib;
@@ -7610,6 +7611,22 @@ package body Freeze is
          Set_Is_Pure (E, False);
       end if;
 
+      --  We also reset the Pure indication on a subprogram with an Address
+      --  parameter, because the parameter may be used as a pointer and the
+      --  referenced data may change even if the address value does not.
+
+      --  Note that if the programmer gave an explicit Pure_Function pragma,
+      --  then we believe the programmer, and leave the subprogram Pure.
+      --  We also suppress this check on run-time files.
+
+      if Is_Pure (E)
+        and then Is_Subprogram (E)
+        and then not Has_Pragma_Pure_Function (E)
+        and then not Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
+      then
+         Check_Function_With_Address_Parameter (E);
+      end if;
+
       --  For non-foreign convention subprograms, this is where we create
       --  the extra formals (for accessibility level and constrained bit
       --  information). We delay this till the freeze point precisely so
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 35b3269..476802e 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2091,6 +2091,34 @@ package body Sem_Util is
       end if;
    end Check_Fully_Declared;
 
+   -------------------------------------------
+   -- Check_Function_With_Address_Parameter --
+   -------------------------------------------
+
+   procedure Check_Function_With_Address_Parameter (Subp_Id : Entity_Id) is
+      F : Entity_Id;
+      T : Entity_Id;
+
+   begin
+      F := First_Formal (Subp_Id);
+      while Present (F) loop
+         T := Etype (F);
+
+         if Is_Private_Type (T) and then Present (Full_View (T)) then
+            T := Full_View (T);
+         end if;
+
+         if Is_Descendent_Of_Address (T)
+           or else Is_Limited_Type (T)
+         then
+            Set_Is_Pure (Subp_Id, False);
+            exit;
+         end if;
+
+         Next_Formal (F);
+      end loop;
+   end Check_Function_With_Address_Parameter;
+
    -------------------------------------
    -- Check_Function_Writable_Actuals --
    -------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 9d77c7f..d05c42b 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -322,6 +322,14 @@ package Sem_Util is
    --  N is one of the statement forms that is a potentially blocking
    --  operation. If it appears within a protected action, emit warning.
 
+   procedure Check_Function_With_Address_Parameter (Subp_Id : Entity_Id);
+   --  A subprogram that has an Address parameter and is declared in a Pure
+   --  package is not considered Pure, because the parameter may be used as a
+   --  pointer and the referenced data may change even if the address value
+   --  itself does not.
+   --  If the programmer gave an explicit Pure_Function pragma, then we respect
+   --  the pragma and leave the subprogram Pure.
+
    procedure Check_Result_And_Post_State (Subp_Id : Entity_Id);
    --  Determine whether the contract of subprogram Subp_Id mentions attribute
    --  'Result and it contains an expression that evaluates differently in pre-