+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 &
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
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
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;
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;
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
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 --
-------------------------------------
-- 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-
projects / gcc.git / commitdiff