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:
parent
10fb8ecd51
commit
b1c11e0e0a
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
@ -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,
|
||||
|
@ -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);
|
||||
|
@ -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);
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user