mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
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:
parent
fb757f7da4
commit
a8a42b933c
|
|
@ -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>
|
2016-06-16 Hristian Kirtchev <kirtchev@adacore.com>
|
||||||
|
|
||||||
* exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor
|
* exp_attr.adb, inline.adb, sem_attr.adb, sem_elab.adb: Minor
|
||||||
|
|
|
||||||
|
|
@ -4720,26 +4720,42 @@ package body Exp_Util is
|
||||||
Expr : Node_Id := Original_Node (N);
|
Expr : Node_Id := Original_Node (N);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Nkind (Expr) = N_Function_Call then
|
-- When a function call appears in Object.Operation format, the
|
||||||
|
-- original representation has three possible forms depending on the
|
||||||
|
-- availability and form of actual parameters:
|
||||||
|
|
||||||
|
-- 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
|
||||||
|
|
||||||
|
case Nkind (Expr) is
|
||||||
|
when N_Function_Call =>
|
||||||
Expr := Name (Expr);
|
Expr := Name (Expr);
|
||||||
|
|
||||||
-- When a function call appears in Object.Operation format, the
|
-- Check for "Obj.Func (Formal => Actual)" case
|
||||||
-- original representation has two possible forms depending on the
|
|
||||||
-- availability of actual parameters:
|
|
||||||
|
|
||||||
-- Obj.Func_Call N_Selected_Component
|
|
||||||
-- Obj.Func_Call (Param) N_Indexed_Component
|
|
||||||
|
|
||||||
else
|
|
||||||
if Nkind (Expr) = N_Indexed_Component then
|
|
||||||
Expr := Prefix (Expr);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Nkind (Expr) = N_Selected_Component then
|
if Nkind (Expr) = N_Selected_Component then
|
||||||
Expr := Selector_Name (Expr);
|
Expr := Selector_Name (Expr);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- "Obj.Func (Actual)" case
|
||||||
|
|
||||||
|
when N_Indexed_Component =>
|
||||||
|
Expr := Prefix (Expr);
|
||||||
|
|
||||||
|
if Nkind (Expr) = N_Selected_Component then
|
||||||
|
Expr := Selector_Name (Expr);
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- "Obj.Func" case
|
||||||
|
|
||||||
|
when N_Selected_Component =>
|
||||||
|
Expr := Selector_Name (Expr);
|
||||||
|
|
||||||
|
when others => null;
|
||||||
|
end case;
|
||||||
|
|
||||||
return
|
return
|
||||||
Nkind_In (Expr, N_Expanded_Name, N_Identifier)
|
Nkind_In (Expr, N_Expanded_Name, N_Identifier)
|
||||||
and then Ekind (Entity (Expr)) = E_Function
|
and then Ekind (Entity (Expr)) = E_Function
|
||||||
|
|
|
||||||
|
|
@ -3397,6 +3397,18 @@ package body Sem_Ch4 is
|
||||||
Next_Actual (Actual);
|
Next_Actual (Actual);
|
||||||
Next_Formal (Formal);
|
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
|
-- For an Ada 2012 predicate or invariant, a call may mention
|
||||||
-- an incomplete type, while resolution of the corresponding
|
-- an incomplete type, while resolution of the corresponding
|
||||||
-- predicate function may see the full view, as a consequence
|
-- predicate function may see the full view, as a consequence
|
||||||
|
|
@ -6806,6 +6818,20 @@ package body Sem_Ch4 is
|
||||||
|
|
||||||
return;
|
return;
|
||||||
end;
|
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;
|
end if;
|
||||||
|
|
||||||
-- Comparisons on A'Access are common enough to deserve a
|
-- 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)));
|
Unchecked_Convert_To (Etype (L), Relocate_Node (R)));
|
||||||
Analyze_Equality_Op (N);
|
Analyze_Equality_Op (N);
|
||||||
return;
|
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;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2684,6 +2684,14 @@ package body Sem_Res is
|
||||||
Analyze_And_Resolve (N, Typ);
|
Analyze_And_Resolve (N, Typ);
|
||||||
Ghost_Mode := Save_Ghost_Mode;
|
Ghost_Mode := Save_Ghost_Mode;
|
||||||
return;
|
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;
|
end if;
|
||||||
|
|
||||||
-- That special Allow_Integer_Address check did not appply, so we
|
-- That special Allow_Integer_Address check did not appply, so we
|
||||||
|
|
|
||||||
|
|
@ -10386,6 +10386,48 @@ package body Sem_Util is
|
||||||
return Name_Find;
|
return Name_Find;
|
||||||
end Remove_Suffix;
|
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 --
|
-- Has_Tagged_Component --
|
||||||
--------------------------
|
--------------------------
|
||||||
|
|
@ -12471,9 +12513,6 @@ package body Sem_Util is
|
||||||
if Is_Entity_Name (N) then
|
if Is_Entity_Name (N) then
|
||||||
return Is_Effectively_Volatile (Entity (N));
|
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
|
elsif Nkind (N) = N_Indexed_Component then
|
||||||
return Is_Effectively_Volatile_Object (Prefix (N));
|
return Is_Effectively_Volatile_Object (Prefix (N));
|
||||||
|
|
||||||
|
|
@ -17490,6 +17529,44 @@ package body Sem_Util is
|
||||||
end loop;
|
end loop;
|
||||||
end Note_Possible_Modification;
|
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 --
|
-- Object_Access_Level --
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|
|
||||||
|
|
@ -1933,6 +1933,14 @@ package Sem_Util is
|
||||||
-- (e.g. target of assignment, or out parameter), and to False if the
|
-- (e.g. target of assignment, or out parameter), and to False if the
|
||||||
-- modification is only potential (e.g. address of entity taken).
|
-- 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;
|
function Object_Access_Level (Obj : Node_Id) return Uint;
|
||||||
-- Return the accessibility level of the view of the object Obj. For
|
-- Return the accessibility level of the view of the object Obj. For
|
||||||
-- convenience, qualified expressions applied to object names are also
|
-- 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;
|
function Remove_Suffix (E : Entity_Id; Suffix : Character) return Name_Id;
|
||||||
-- Returns the name of E without Suffix
|
-- 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;
|
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
|
-- 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
|
-- which is Standard_True if range checks are enabled (E is an entity to
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue