===================================================================
@@ -36,6 +36,7 @@
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 @@
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
===================================================================
@@ -2091,6 +2091,34 @@
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 --
-------------------------------------
===================================================================
@@ -322,6 +322,14 @@
-- 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-
===================================================================
@@ -5035,6 +5035,23 @@
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 @@
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
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. This check was previously performed only on the subprogram body, leading to improper optimizations when invoking such functions declared in a pure package. It is now performed as well at the freeze point of the subprogram. The following must execute quietly: gnatmake -q main -O --- with Pure_Pkg; use Pure_Pkg; procedure Main is I : Integer; begin I := Add_Three (0); if I /= 3 then raise Program_Error; end if; I := 0; I := Bump_Int (I'Address); I := Bump_Int (I'Address); I := Bump_Int (I'Address); if I /= 3 then raise Program_Error; end if; end; --- package body Pure_Pkg is function Add_Three (I : Integer) return Integer is J : Integer := I; begin J := Bump_Int (J'Address); J := Bump_Int (J'Address); J := Bump_Int (J'Address); return J; end; function Bump_Int (X : System.Address) return Integer is I : Integer; for I'Address use X; begin return I + 1; end; end Pure_Pkg; --- with System; package Pure_Pkg is pragma Pure; function Add_Three (I : Integer) return Integer; function Bump_Int (X : System.Address) return Integer; end Pure_Pkg; Tested on x86_64-pc-linux-gnu, committed on trunk 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.