Commit 90e7b558 by Arnaud Charlet

[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
parent 45fbea4f
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 &
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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 --
-------------------------------------
......
......@@ -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-
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment