OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2016-06-16  Javier Miranda  <miranda@adacore.com>

	* sem_res.adb (Resolve): Under relaxed RM semantics silently
	replace occurrences of null by System.Null_Address.
	* sem_ch4.adb (Analyze_One_Call, Operator_Check): Under
	relaxed RM semantics silently replace occurrences of null by
	System.Null_Address.
	* sem_util.ad[sb] (Null_To_Null_Address_Convert_OK): New subprogram.
	(Replace_Null_By_Null_Address): New subprogram.

2016-06-16  Bob Duff  <duff@adacore.com>

	* exp_util.adb (Is_Controlled_Function_Call):
	This was missing the case where the call is in prefix format,
	with named notation, as in Obj.Func (Formal => Actual).

From-SVN: r237508
This commit is contained in:
Arnaud Charlet 2016-06-16 11:52:17 +02:00
parent fb757f7da4
commit a8a42b933c
6 changed files with 180 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2016-06-16 Javier Miranda <miranda@adacore.com>
* sem_res.adb (Resolve): Under relaxed RM semantics silently
replace occurrences of null by System.Null_Address.
* sem_ch4.adb (Analyze_One_Call, Operator_Check): Under
relaxed RM semantics silently replace occurrences of null by
System.Null_Address.
* sem_util.ad[sb] (Null_To_Null_Address_Convert_OK): New subprogram.
(Replace_Null_By_Null_Address): New subprogram.
2016-06-16 Bob Duff <duff@adacore.com>
* exp_util.adb (Is_Controlled_Function_Call):
This was missing the case where the call is in prefix format,
with named notation, as in Obj.Func (Formal => Actual).
2016-06-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor

42
gcc/ada/exp_util.adb
View File

@ -4720,25 +4720,41 @@ package body Exp_Util is
Expr : Node_Id := Original_Node (N);
begin
if Nkind (Expr) = N_Function_Call then
Expr := Name (Expr);
-- When a function call appears in Object.Operation format, the
-- original representation has two possible forms depending on the
-- availability of actual parameters:
-- original representation has three possible forms depending on the
-- availability and form of actual parameters:
-- Obj.Func_Call N_Selected_Component
-- Obj.Func_Call (Param) N_Indexed_Component
-- Obj.Func N_Selected_Component
-- Obj.Func (Actual) N_Indexed_Component
-- Obj.Func (Formal => Actual) N_Function_Call, whose Name is an
-- N_Selected_Component
else
if Nkind (Expr) = N_Indexed_Component then
case Nkind (Expr) is
when N_Function_Call =>
Expr := Name (Expr);
-- Check for "Obj.Func (Formal => Actual)" case
if Nkind (Expr) = N_Selected_Component then
Expr := Selector_Name (Expr);
end if;
-- "Obj.Func (Actual)" case
when N_Indexed_Component =>
Expr := Prefix (Expr);
end if;
if Nkind (Expr) = N_Selected_Component then
if Nkind (Expr) = N_Selected_Component then
Expr := Selector_Name (Expr);
end if;
-- "Obj.Func" case
when N_Selected_Component =>
Expr := Selector_Name (Expr);
end if;
end if;
when others => null;
end case;
return
Nkind_In (Expr, N_Expanded_Name, N_Identifier)

34
gcc/ada/sem_ch4.adb
View File

@ -3397,6 +3397,18 @@ package body Sem_Ch4 is
Next_Actual (Actual);
Next_Formal (Formal);
-- Under relaxed RM semantics silently replace occurrences of
-- null by System.Address_Null. We only do this if we know that
-- an error will otherwise be issued.
elsif Null_To_Null_Address_Convert_OK (Actual, Etype (Formal))
and then (Report and not Is_Indexed and not Is_Indirect)
then
Replace_Null_By_Null_Address (Actual);
Analyze_And_Resolve (Actual, Etype (Formal));
Next_Actual (Actual);
Next_Formal (Formal);
-- For an Ada 2012 predicate or invariant, a call may mention
-- an incomplete type, while resolution of the corresponding
-- predicate function may see the full view, as a consequence
@ -6806,6 +6818,20 @@ package body Sem_Ch4 is
return;
end;
-- Under relaxed RM semantics silently replace occurrences of
-- null by System.Address_Null.
elsif Null_To_Null_Address_Convert_OK (N) then
Replace_Null_By_Null_Address (N);
if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then
Analyze_Comparison_Op (N);
else
Analyze_Arithmetic_Op (N);
end if;
return;
end if;
-- Comparisons on A'Access are common enough to deserve a
@ -6875,6 +6901,14 @@ package body Sem_Ch4 is
Unchecked_Convert_To (Etype (L), Relocate_Node (R)));
Analyze_Equality_Op (N);
return;
-- Under relaxed RM semantics silently replace occurrences of
-- null by System.Address_Null.
elsif Null_To_Null_Address_Convert_OK (N) then
Replace_Null_By_Null_Address (N);
Analyze_Equality_Op (N);
return;
end if;
end if;

8
gcc/ada/sem_res.adb
View File

@ -2684,6 +2684,14 @@ package body Sem_Res is
Analyze_And_Resolve (N, Typ);
Ghost_Mode := Save_Ghost_Mode;
return;
-- Under relaxed RM semantics silently replace occurrences of null
-- by System.Address_Null
elsif Null_To_Null_Address_Convert_OK (N, Typ) then
Replace_Null_By_Null_Address (N);
Analyze_And_Resolve (N, Typ);
return;
end if;
-- That special Allow_Integer_Address check did not appply, so we

83
gcc/ada/sem_util.adb
View File

@ -10386,6 +10386,48 @@ package body Sem_Util is
return Name_Find;
end Remove_Suffix;
----------------------------------
-- Replace_Null_By_Null_Address --
----------------------------------
procedure Replace_Null_By_Null_Address (N : Node_Id) is
begin
pragma Assert (Relaxed_RM_Semantics);
pragma Assert
(Nkind (N) = N_Null
or else Nkind_In (N, N_Op_Eq, N_Op_Ne)
or else Nkind_In (N, N_Op_Lt, N_Op_Le, N_Op_Gt, N_Op_Ge));
if Nkind (N) = N_Null then
Rewrite (N,
New_Occurrence_Of (RTE (RE_Null_Address), Sloc (N)));
else
declare
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
begin
-- We check the Etype of the complementary operand since the
-- N_Null node is not decorated at this stage.
if Nkind (L) = N_Null
and then Is_Descendant_Of_Address (Etype (R))
then
Rewrite (L,
New_Occurrence_Of (RTE (RE_Null_Address), Sloc (L)));
end if;
if Nkind (R) = N_Null
and then Is_Descendant_Of_Address (Etype (L))
then
Rewrite (R,
New_Occurrence_Of (RTE (RE_Null_Address), Sloc (R)));
end if;
end;
end if;
end Replace_Null_By_Null_Address;
--------------------------
-- Has_Tagged_Component --
--------------------------
@ -12471,9 +12513,6 @@ package body Sem_Util is
if Is_Entity_Name (N) then
return Is_Effectively_Volatile (Entity (N));
elsif Nkind (N) = N_Expanded_Name then
return Is_Effectively_Volatile (Entity (N));
elsif Nkind (N) = N_Indexed_Component then
return Is_Effectively_Volatile_Object (Prefix (N));
@ -17490,6 +17529,44 @@ package body Sem_Util is
end loop;
end Note_Possible_Modification;
--------------------------------------
-- Null_To_Null_Address_Convert_OK --
--------------------------------------
function Null_To_Null_Address_Convert_OK
(N : Node_Id;
Typ : Entity_Id := Empty) return Boolean is
begin
if not Relaxed_RM_Semantics then
return False;
end if;
if Nkind (N) = N_Null then
return Present (Typ) and then Is_Descendant_Of_Address (Typ);
elsif Nkind_In (N, N_Op_Eq, N_Op_Ne)
or else Nkind_In (N, N_Op_Lt, N_Op_Le, N_Op_Gt, N_Op_Ge)
then
declare
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
begin
-- We check the Etype of the complementary operand since the
-- N_Null node is not decorated at this stage.
return
((Nkind (L) = N_Null
and then Is_Descendant_Of_Address (Etype (R)))
or else
(Nkind (R) = N_Null
and then Is_Descendant_Of_Address (Etype (L))));
end;
end if;
return False;
end Null_To_Null_Address_Convert_OK;
-------------------------
-- Object_Access_Level --
-------------------------

13
gcc/ada/sem_util.ads
View File

@ -1933,6 +1933,14 @@ package Sem_Util is
-- (e.g. target of assignment, or out parameter), and to False if the
-- modification is only potential (e.g. address of entity taken).
function Null_To_Null_Address_Convert_OK
(N : Node_Id;
Typ : Entity_Id := Empty) return Boolean;
-- Return True if we are compiling in relaxed RM semantics mode and:
-- 1) N is a N_Null node and Typ is a decendant of System.Address, or
-- 2) N is a comparison operator, one of the operands is null and the
-- type of the other operand is a descendant of System.Address.
function Object_Access_Level (Obj : Node_Id) return Uint;
-- Return the accessibility level of the view of the object Obj. For
-- convenience, qualified expressions applied to object names are also
@ -2044,6 +2052,11 @@ package Sem_Util is
function Remove_Suffix (E : Entity_Id; Suffix : Character) return Name_Id;
-- Returns the name of E without Suffix
procedure Replace_Null_By_Null_Address (N : Node_Id);
-- N is N_Null or a binary comparison operator, we are compiling in relaxed
-- RM semantics mode and one of the operands is null. Replace null by
-- System.Null_Address.
function Rep_To_Pos_Flag (E : Entity_Id; Loc : Source_Ptr) return Node_Id;
-- This is used to construct the second argument in a call to Rep_To_Pos
-- which is Standard_True if range checks are enabled (E is an entity to