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