-- d_M Ignore Source_File_Name and Source_File_Name_Project pragmas
-- d_N
-- d_O
- -- d_P
+ -- d_P Enable runtime check for null prefix of prefixed subprogram call
-- d_Q
-- d_R For LLVM, dump the representation of records
-- d_S
-- it is checked, and the progress of the recursive trace through
-- elaboration calls at compile time.
+ -- d_P For prefixed subprogram calls with an access-type prefix, generate
+ -- a null-excluding runtime check on the prefix, even when the called
+ -- subprogram has a first access parameter that does not exclude null
+ -- (that is the case only for class-wide parameter, as controlling
+ -- parameters are automatically null-excluding). In such a case,
+ -- P.Proc is equivalent to Proc(P.all'Access); see RM 6.4(9.1/5).
+ -- This includes a dereference, and thus a null check.
+
-- d_R In the LLVM backend, output the internal representation of
-- each record
Is_Elsif,
Is_Entry_Barrier_Function,
Is_Expanded_Build_In_Place_Call,
+ Is_Expanded_Prefixed_Call,
Is_Folded_In_Parser,
Is_Generic_Contract_Pragma,
Is_Homogeneous_Aggregate,
Cc (N_Function_Call, N_Subprogram_Call,
(Sy (Name, Node_Id, Default_Empty),
Sy (Parameter_Associations, List_Id, Default_No_List),
- Sm (Is_Expanded_Build_In_Place_Call, Flag)));
+ Sm (Is_Expanded_Build_In_Place_Call, Flag),
+ Sm (Is_Expanded_Prefixed_Call, Flag)));
Cc (N_Procedure_Call_Statement, N_Subprogram_Call,
(Sy (Name, Node_Id, Default_Empty),
- Sy (Parameter_Associations, List_Id, Default_No_List)));
+ Sy (Parameter_Associations, List_Id, Default_No_List),
+ Sm (Is_Expanded_Prefixed_Call, Flag)));
Ab (N_Raise_xxx_Error, N_Subexpr);
Error_Msg_NE
("expect variable in call to&", Prefix (N), Entity (Subprog));
end if;
-
-- Conversely, if the formal is an access parameter and the object is
-- not an access type or a reference type (i.e. a type with the
-- Implicit_Dereference aspect specified), replace the actual with a
Rewrite (Node_To_Replace, Call_Node);
+ Set_Is_Expanded_Prefixed_Call (Node_To_Replace);
+
-- Propagate the interpretations collected in subprog to the new
-- function call node, to be resolved from context.
Complete_Object_Operation
(Call_Node => New_Call_Node,
Node_To_Replace => Node_To_Replace);
+
return True;
end if;
-------------------------
procedure Check_Prefixed_Call is
- Act : constant Node_Id := First_Actual (N);
- A_Type : constant Entity_Id := Etype (Act);
- F_Type : constant Entity_Id := Etype (First_Formal (Nam));
- Orig : constant Node_Id := Original_Node (N);
- New_A : Node_Id;
+ Actual : constant Node_Id := First_Actual (N);
+ Actual_Type : constant Entity_Id := Etype (Actual);
+ Formal_Type : constant Entity_Id := Etype (First_Formal (Nam));
+ New_Actual : Node_Id;
begin
-- Check whether the call is a prefixed call, with or without
-- additional actuals.
- if Nkind (Orig) = N_Selected_Component
- or else
- (Nkind (Orig) = N_Indexed_Component
- and then Nkind (Prefix (Orig)) = N_Selected_Component
- and then Is_Entity_Name (Prefix (Prefix (Orig)))
- and then Is_Entity_Name (Act)
- and then Chars (Act) = Chars (Prefix (Prefix (Orig))))
- then
- if Is_Access_Type (A_Type)
- and then not Is_Access_Type (F_Type)
- then
- -- Introduce dereference on object in prefix
+ if Is_Expanded_Prefixed_Call (N) then
- New_A :=
- Make_Explicit_Dereference (Sloc (Act),
- Prefix => Relocate_Node (Act));
- Rewrite (Act, New_A);
- Analyze (Act);
+ -- Introduce dereference on object in prefix
- elsif Is_Access_Type (F_Type)
- and then not Is_Access_Type (A_Type)
+ if Is_Access_Type (Actual_Type)
+ and then not Is_Access_Type (Formal_Type)
then
- -- Introduce an implicit 'Access in prefix
-
- if not Is_Aliased_View (Act) then
- Error_Msg_NE
- ("object in prefixed call to& must be aliased "
- & "(RM 4.1.3 (13 1/2))",
- Prefix (Act), Nam);
- end if;
-
- Rewrite (Act,
+ New_Actual :=
+ Make_Explicit_Dereference (Sloc (Actual),
+ Prefix => Relocate_Node (Actual));
+ Rewrite (Actual, New_Actual);
+ Analyze (Actual);
+
+ -- Conversely, if the formal is an access parameter and the object
+ -- is not an access type or a reference type (i.e. a type with the
+ -- Implicit_Dereference aspect specified), add an implicit 'Access
+ -- to the prefix. Its analysis will check that the object is
+ -- aliased.
+
+ elsif Is_Access_Type (Formal_Type)
+ and then not Is_Access_Type (Actual_Type)
+ and then (not Has_Implicit_Dereference (Actual_Type)
+ or else
+ not Is_Access_Type
+ (Designated_Type
+ (Etype (Get_Reference_Discriminant (Actual_Type)))))
+ then
+ Rewrite (Actual,
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Access,
- Prefix => Relocate_Node (Act)));
+ Prefix => Relocate_Node (Actual)));
+ Analyze (Actual);
end if;
-
- Analyze (Act);
end if;
end Check_Prefixed_Call;
Reason => CE_Null_Not_Allowed);
end if;
end if;
+
+ -- In a prefixed call, if the prefix is an access type
+ -- it cannot be null.
+
+ if Is_Access_Type (F_Typ)
+ and then A = First_Actual (N)
+ and then Is_Expanded_Prefixed_Call (N)
+ then
+ if not Is_Access_Type (A_Typ)
+ and then not Is_Aliased_View (A)
+ then
+ Error_Msg_NE
+ ("object in prefixed call to& must be aliased "
+ & "(RM 4.1.3 (13 1/2))",
+ A, Nam);
+ end if;
+
+ if Debug_Flag_Underscore_PP
+ and then
+ (Is_Controlling_Formal (F)
+ or else Is_Class_Wide_Type (Designated_Type (F_Typ)))
+ then
+ Install_Null_Excluding_Check (A);
+ end if;
+ end if;
end if;
-- Checks for OUT parameters and IN OUT parameters
-- actuals to support a build-in-place style of call have been added to
-- the call.
+ -- Is_Expanded_Prefixed_Call
+ -- This flag is set in N_Function_Call and N_Procedure_Call_Statement
+ -- nodes to indicate that it is an expanded prefixed call.
+
-- Is_Generic_Contract_Pragma
-- This flag is present in N_Pragma nodes. It is set when the pragma is
-- a source construct, applies to a generic unit or its body, and denotes
-- First_Named_Actual
-- Controlling_Argument (set to Empty if not dispatching)
-- Is_Elaboration_Checks_OK_Node
+ -- Is_Expanded_Prefixed_Call
-- Is_SPARK_Mode_On_Node
-- Is_Elaboration_Warnings_OK_Node
-- No_Elaboration_Check
-- Is_Elaboration_Warnings_OK_Node
-- No_Elaboration_Check
-- Is_Expanded_Build_In_Place_Call
+ -- Is_Expanded_Prefixed_Call
-- Is_Known_Guaranteed_ABE
-- plus fields for expression
projects / thirdparty / gcc.git / commitdiff
