+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
-- 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)",
-- 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;
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.
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
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;
Comp := Object_Definition (N);
Acc := Comp;
+ when N_Function_Specification =>
+ Comp := Result_Definition (N);
+ Acc := Comp;
+
when others =>
raise Program_Error;
end case;
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,
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);
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);
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
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
------------------
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.
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.
-- 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
if T1 = T2 then
return True;
- elsif BT1 = BT2
+ elsif BT1 = BT2
or else BT1 = T2
or else BT2 = T1
then
projects / thirdparty / gcc.git / commitdiff
