sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support for N_Formal_Object_Declaration nodes.

2008-08-04  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support
	for N_Formal_Object_Declaration nodes. Adding kludge required by
	First_Formal to provide its functionality with access to functions.
	(Replace_Anonymous_Access_To_Protected_Subprogram): Add missing support
	for anonymous access types returned by functions.

	* sem_ch5.adb (Analyze_Assignment): Code cleanup to avoid duplicate
	conversion of null-excluding access types (required only once to force
	the generation of the required runtime check).

	* sem_type.adb (Covers): minor reformating

	* checks.adb (Null_Exclusion_Static_Checks): Avoid reporting errors
	with internally generated nodes. Avoid generating the error inside init
	procs.

	* sem_res.adb (Resolve_Membership_Test): Minor reformating.
	(Resolve_Null): Generate the null-excluding check in case of assignment
	to a null-excluding object.
	(Valid_Conversion): Add missing support for anonymous access to
	subprograms.

	* sem_ch6.adb (Check_Return_Subtype_Indication): Add missing support for
	anonymous access types whose designated type is an itype. This case
	occurs with anonymous access to protected subprograms types.
	(Analyze_Return_Type):  Add missing support for anonymous access to
	protected subprogram.

	* sem_eval.adb (Subtypes_Statically_Match): In case of access to
	subprograms addition of missing check on matching convention. Required
	to properly handle access to protected subprogram types.

	* exp_ch3 (Build_Assignment): Code cleanup removing duplicated check on
	null excluding access types.

From-SVN: r138610
This commit is contained in:
Javier Miranda 2008-08-04 12:14:25 +00:00 committed by Arnaud Charlet
parent 10fb8ecd51
commit b1c11e0e0a
9 changed files with 137 additions and 48 deletions

View File

@ -1,3 +1,40 @@
2008-08-04 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support
for N_Formal_Object_Declaration nodes. Adding kludge required by
First_Formal to provide its functionality with access to functions.
(Replace_Anonymous_Access_To_Protected_Subprogram): Add missing support
for anonymous access types returned by functions.
* sem_ch5.adb (Analyze_Assignment): Code cleanup to avoid duplicate
conversion of null-excluding access types (required only once to force
the generation of the required runtime check).
* sem_type.adb (Covers): minor reformating
* checks.adb (Null_Exclusion_Static_Checks): Avoid reporting errors
with internally generated nodes. Avoid generating the error inside init
procs.
* sem_res.adb (Resolve_Membership_Test): Minor reformating.
(Resolve_Null): Generate the null-excluding check in case of assignment
to a null-excluding object.
(Valid_Conversion): Add missing support for anonymous access to
subprograms.
* sem_ch6.adb (Check_Return_Subtype_Indication): Add missing support for
anonymous access types whose designated type is an itype. This case
occurs with anonymous access to protected subprograms types.
(Analyze_Return_Type): Add missing support for anonymous access to
protected subprogram.
* sem_eval.adb (Subtypes_Statically_Match): In case of access to
subprograms addition of missing check on matching convention. Required
to properly handle access to protected subprogram types.
* exp_ch3 (Build_Assignment): Code cleanup removing duplicated check on
null excluding access types.
2008-08-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb: Add comments

View File

@ -2871,11 +2871,7 @@ package body Checks is
-- be applied to a [sub]type that does not exclude null already.
elsif Can_Never_Be_Null (Typ)
-- No need to check itypes that have a null exclusion because
-- they are already examined at their point of creation.
and then not Is_Itype (Typ)
and then Comes_From_Source (Typ)
then
Error_Msg_NE
("`NOT NULL` not allowed (& already excludes null)",
@ -5306,10 +5302,20 @@ package body Checks is
-- If known to be null, here is where we generate a compile time check
if Known_Null (N) then
Apply_Compile_Time_Constraint_Error
(N,
"null value not allowed here?",
CE_Access_Check_Failed);
-- Avoid generating warning message inside init procs
if not Inside_Init_Proc then
Apply_Compile_Time_Constraint_Error
(N,
"null value not allowed here?",
CE_Access_Check_Failed);
else
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Reason => CE_Access_Check_Failed));
end if;
Mark_Non_Null;
return;
end if;

View File

@ -1826,23 +1826,6 @@ package body Exp_Ch3 is
Attribute_Name => Name_Unrestricted_Access);
end if;
-- Ada 2005 (AI-231): Add the run-time check if required
if Ada_Version >= Ada_05
and then Can_Never_Be_Null (Etype (Id)) -- Lhs
then
if Known_Null (Exp) then
return New_List (
Make_Raise_Constraint_Error (Sloc (Exp),
Reason => CE_Null_Not_Allowed));
elsif Present (Etype (Exp))
and then not Can_Never_Be_Null (Etype (Exp))
then
Install_Null_Excluding_Check (Exp);
end if;
end if;
-- Take a copy of Exp to ensure that later copies of this component
-- declaration in derived types see the original tree, not a node
-- rewritten during expansion of the init_proc.

View File

@ -1056,6 +1056,7 @@ package body Sem_Ch3 is
N_Object_Renaming_Declaration,
N_Formal_Object_Declaration,
N_Formal_Type_Declaration,
N_Formal_Object_Declaration,
N_Task_Type_Declaration,
N_Protected_Type_Declaration))
loop
@ -1117,13 +1118,32 @@ package body Sem_Ch3 is
if Present (Formals) then
Push_Scope (Desig_Type);
-- A bit of a kludge here. These kludges will be removed when Itypes
-- have proper parent pointers to their declarations???
-- Kludge 1) Link definining_identifier of formals. Required by
-- First_Formal to provide its functionality.
declare
F : Node_Id;
begin
F := First (Formals);
while Present (F) loop
if No (Parent (Defining_Identifier (F))) then
Set_Parent (Defining_Identifier (F), F);
end if;
Next (F);
end loop;
end;
Process_Formals (Formals, Parent (T_Def));
-- A bit of a kludge here, End_Scope requires that the parent
-- pointer be set to something reasonable, but Itypes don't have
-- parent pointers. So we set it and then unset it ??? If and when
-- Itypes have proper parent pointers to their declarations, this
-- kludge can be removed.
-- Kludge 2) End_Scope requires that the parent pointer be set to
-- something reasonable, but Itypes don't have parent pointers. So
-- we set it and then unset it ???
Set_Parent (Desig_Type, T_Name);
End_Scope;
@ -4441,6 +4461,10 @@ package body Sem_Ch3 is
Comp := Object_Definition (N);
Acc := Comp;
when N_Function_Specification =>
Comp := Result_Definition (N);
Acc := Comp;
when others =>
raise Program_Error;
end case;
@ -4485,6 +4509,10 @@ package body Sem_Ch3 is
elsif Nkind (N) = N_Access_Function_Definition then
Rewrite (Comp, New_Occurrence_Of (Anon, Loc));
elsif Nkind (N) = N_Function_Specification then
Rewrite (Comp, New_Occurrence_Of (Anon, Loc));
Set_Etype (Defining_Unit_Name (N), Anon);
else
Rewrite (Comp,
Make_Component_Definition (Loc,

View File

@ -579,18 +579,15 @@ package body Sem_Ch5 is
end if;
end if;
-- Ada 2005 (AI-230 and AI-385): When the lhs type is an anonymous
-- access type, apply an implicit conversion of the rhs to that type
-- to force appropriate static and run-time accessibility checks.
-- This applies as well to anonymous access-to-subprogram types that
-- Ada 2005 (AI-385): When the lhs type is an anonymous access type,
-- apply an implicit conversion of the rhs to that type to force
-- appropriate static and run-time accessibility checks. This
-- applies as well to anonymous access-to-subprogram types that
-- are component subtypes.
if Ada_Version >= Ada_05
and then
Is_Access_Type (T1)
and then
(Is_Local_Anonymous_Access (T1)
or else Can_Never_Be_Null (T1))
and then Is_Access_Type (T1)
and then Is_Local_Anonymous_Access (T1)
then
Rewrite (Rhs, Convert_To (T1, Relocate_Node (Rhs)));
Analyze_And_Resolve (Rhs, T1);

View File

@ -1262,7 +1262,20 @@ package body Sem_Ch6 is
if Result_Definition (N) /= Error then
if Nkind (Result_Definition (N)) = N_Access_Definition then
Typ := Access_Definition (N, Result_Definition (N));
-- Ada 2005 (AI-254): Handle anonymous access to subprograms
declare
AD : constant Node_Id :=
Access_To_Subprogram_Definition (Result_Definition (N));
begin
if Present (AD) and then Protected_Present (AD) then
Typ := Replace_Anonymous_Access_To_Protected_Subprogram (N);
else
Typ := Access_Definition (N, Result_Definition (N));
end if;
end;
Set_Parent (Typ, Result_Definition (N));
Set_Is_Local_Anonymous_Access (Typ);
Set_Etype (Designator, Typ);

View File

@ -4388,7 +4388,12 @@ package body Sem_Eval is
return
Subtype_Conformant
(Designated_Type (T1),
Designated_Type (T2));
Designated_Type (T2))
-- Convention check required to cover protected subprograms
and then Convention (Designated_Type (T1)) =
Convention (Designated_Type (T2));
else
return
Subtypes_Statically_Match

View File

@ -6572,8 +6572,8 @@ package body Sem_Res is
procedure Resolve_Membership_Op (N : Node_Id; Typ : Entity_Id) is
pragma Warnings (Off, Typ);
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
L : constant Node_Id := Left_Opnd (N);
R : constant Node_Id := Right_Opnd (N);
T : Entity_Id;
begin
@ -6638,6 +6638,8 @@ package body Sem_Res is
------------------
procedure Resolve_Null (N : Node_Id; Typ : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
begin
-- Handle restriction against anonymous null access values This
-- restriction can be turned off using -gnatdj.
@ -6666,6 +6668,26 @@ package body Sem_Res is
end if;
end if;
-- Ada 2005 (AI-231): Generate the null-excluding check in case of
-- assignment to a null-excluding object
if Ada_Version >= Ada_05
and then Can_Never_Be_Null (Typ)
and then Nkind (Parent (N)) = N_Assignment_Statement
then
if not Inside_Init_Proc then
Insert_Action
(Compile_Time_Constraint_Error (N,
"(Ada 2005) null not allowed in null-excluding objects?"),
Make_Raise_Constraint_Error (Loc,
Reason => CE_Access_Check_Failed));
else
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Reason => CE_Access_Check_Failed));
end if;
end if;
-- In a distributed context, null for a remote access to subprogram
-- may need to be replaced with a special record aggregate. In this
-- case, return after having done the transformation.
@ -9511,9 +9533,7 @@ package body Sem_Res is
-- return statement, because in that case the accessibility check
-- takes place after the return.
elsif (Ekind (Target_Type) = E_Access_Subprogram_Type
or else
Ekind (Target_Type) = E_Anonymous_Access_Subprogram_Type)
elsif Ekind (Target_Type) in Access_Subprogram_Kind
and then No (Corresponding_Remote_Type (Opnd_Type))
then
if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type

View File

@ -766,7 +766,7 @@ package body Sem_Type is
if T1 = T2 then
return True;
elsif BT1 = BT2
elsif BT1 = BT2
or else BT1 = T2
or else BT2 = T1
then