From: Javier Miranda Date: Mon, 4 Aug 2008 12:14:25 +0000 (+0000) Subject: sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support for N_Formal_Obje... X-Git-Tag: releases/gcc-4.4.0~3416 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b1c11e0e0a912a1581d060a71f6e1bb02b4f386a;p=thirdparty%2Fgcc.git sem_ch3.adb (Access_Subprogram_Declaration): Adding missing support for N_Formal_Object_Declaration nodes. 2008-08-04 Javier Miranda * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f0a4eda75855..af78d6a35e4d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,40 @@ +2008-08-04 Javier Miranda + + * 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 * sem_ch12.adb: Add comments diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index f55bd7cec75d..38b1a07e4099 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index b110121bc5e7..92a5f8c3b60a 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0ac17bf2efc7..307b6a158b6c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -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, diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 11439419a25e..139675969a93 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -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); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 384bd5790074..ea1a21ed1781 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index d80679158385..ea4f769ea233 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 62822aa7b8c6..6c632fdb5f73 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index aae54d1f67e1..bdd1c388220b 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -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