From 53cf46009d6ebd3039582eda6efa8676dc27c001 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 4 Aug 2008 11:36:10 +0200 Subject: [PATCH] sem_ch3.adb (Access_Definition): A formal object declaration is a legal context for an anonymous access to... 2008-08-04 Ed Schonberg * sem_ch3.adb (Access_Definition): A formal object declaration is a legal context for an anonymous access to subprogram. * sem_ch4.adb (Analyze_One_Call): If the call can be interpreted as an indirect call, report success to the caller to include possible interpretation. * sem_ch6.adb (Check_Return_Type_Indication): Apply proper conformance check when the type of the extended return is an anonymous access_to_subprogram type. * sem_res.adb: (Resolve_Call): Insert a dereference if the type of the subprogram is an access_to_subprogram and the context requires its return type, and a dereference has not been introduced previously. From-SVN: r138591 --- gcc/ada/sem_ch3.adb | 1 + gcc/ada/sem_ch4.adb | 36 +++++++++++++++++++++++++++--------- gcc/ada/sem_ch6.adb | 29 +++++++++++++++++++++++------ gcc/ada/sem_res.adb | 28 +++++++++++++++++++++++++++- 4 files changed, 78 insertions(+), 16 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c95f5da6535..0ac17bf2efc 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1054,6 +1054,7 @@ package body Sem_Ch3 is or else Nkind_In (D_Ityp, N_Object_Declaration, N_Object_Renaming_Declaration, + N_Formal_Object_Declaration, N_Formal_Type_Declaration, N_Task_Type_Declaration, N_Protected_Type_Declaration)) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index eb9b52e3d17..5f23ca28c4f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -2127,11 +2127,12 @@ package body Sem_Ch4 is -- is already known to be compatible, and because this may be an -- indexing of a call with default parameters. - Formal : Entity_Id; - Actual : Node_Id; - Is_Indexed : Boolean := False; - Subp_Type : constant Entity_Id := Etype (Nam); - Norm_OK : Boolean; + Formal : Entity_Id; + Actual : Node_Id; + Is_Indexed : Boolean := False; + Is_Indirect : Boolean := False; + Subp_Type : constant Entity_Id := Etype (Nam); + Norm_OK : Boolean; function Operator_Hidden_By (Fun : Entity_Id) return Boolean; -- There may be a user-defined operator that hides the current @@ -2240,6 +2241,13 @@ package body Sem_Ch4 is -- in prefix notation, so that the rebuilt parameter list has more than -- one actual. + if not Is_Overloadable (Nam) + and then Ekind (Nam) /= E_Subprogram_Type + and then Ekind (Nam) /= E_Entry_Family + then + return; + end if; + if Present (Actuals) and then (Needs_No_Actuals (Nam) @@ -2259,11 +2267,13 @@ package body Sem_Ch4 is -- The prefix can also be a parameterless function that returns an -- access to subprogram, in which case this is an indirect call. + -- If this succeeds, an explicit dereference is added later on, + -- in Analyze_Call or Resolve_Call. elsif Is_Access_Type (Subp_Type) and then Ekind (Designated_Type (Subp_Type)) = E_Subprogram_Type then - Is_Indexed := Try_Indirect_Call (N, Nam, Subp_Type); + Is_Indirect := Try_Indirect_Call (N, Nam, Subp_Type); end if; end if; @@ -2278,13 +2288,21 @@ package body Sem_Ch4 is return; end if; - Normalize_Actuals (N, Nam, (Report and not Is_Indexed), Norm_OK); + Normalize_Actuals + (N, Nam, (Report and not Is_Indexed and not Is_Indirect), Norm_OK); if not Norm_OK then + -- If an indirect call is a possible interpretation, indicate + -- success to the caller. + + if Is_Indirect then + Success := True; + return; + -- Mismatch in number or names of parameters - if Debug_Flag_E then + elsif Debug_Flag_E then Write_Str (" normalization fails in call "); Write_Int (Int (N)); Write_Str (" with subprogram "); @@ -2410,7 +2428,7 @@ package body Sem_Ch4 is Write_Eol; end if; - if Report and not Is_Indexed then + if Report and not Is_Indexed and not Is_Indirect then -- Ada 2005 (AI-251): Complete the error notification -- to help new Ada 2005 users diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 794a05730e5..1ab798240a0 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -542,16 +542,33 @@ package body Sem_Ch6 is -- "return access T" case; check that the return statement also has -- "access T", and that the subtypes statically match: + -- if this is an access to subprogram the signatures must match. if R_Type_Is_Anon_Access then if R_Stm_Type_Is_Anon_Access then - if Base_Type (Designated_Type (R_Stm_Type)) /= - Base_Type (Designated_Type (R_Type)) - or else not Subtypes_Statically_Match (R_Stm_Type, R_Type) + if + Ekind (Designated_Type (R_Stm_Type)) /= E_Subprogram_Type then - Error_Msg_N - ("subtype must statically match function result subtype", - Subtype_Mark (Subtype_Ind)); + if Base_Type (Designated_Type (R_Stm_Type)) /= + Base_Type (Designated_Type (R_Type)) + or else not Subtypes_Statically_Match (R_Stm_Type, R_Type) + then + Error_Msg_N + ("subtype must statically match function result subtype", + Subtype_Mark (Subtype_Ind)); + end if; + + else + -- For two anonymous access to subprogram types, the + -- types themselves must be type conformant. + + if not Conforming_Types + (R_Stm_Type, R_Type, Fully_Conformant) + then + Error_Msg_N + ("subtype must statically match function result subtype", + Subtype_Ind); + end if; end if; else diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 7a767a39179..62822aa7b8c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4692,6 +4692,25 @@ package body Sem_Res is end loop; end if; + if Ekind (Etype (Nam)) = E_Access_Subprogram_Type + and then Ekind (Typ) /= E_Access_Subprogram_Type + and then Nkind (Subp) /= N_Explicit_Dereference + and then Present (Parameter_Associations (N)) + then + -- The prefix is a parameterless function call that returns an + -- access to subprogram. If parameters are present in the current + -- call add an explicit dereference. + + -- The dereference is added either in Analyze_Call or here. Should + -- be consolidated ??? + + Set_Is_Overloaded (Subp, False); + Set_Etype (Subp, Etype (Nam)); + Insert_Explicit_Dereference (Subp); + Nam := Designated_Type (Etype (Nam)); + Resolve (Subp, Nam); + end if; + -- Check that a call to Current_Task does not occur in an entry body if Is_RTE (Nam, RE_Current_Task) then @@ -9487,7 +9506,10 @@ package body Sem_Res is -- Access to subprogram types. If the operand is an access parameter, -- the type has a deeper accessibility that any master, and cannot - -- be assigned. + -- be assigned. We must make an exception if the conversion is part + -- of an assignment and the target is the return object of an extended + -- return statement, because in that case the accessibility check + -- takes place after the return. elsif (Ekind (Target_Type) = E_Access_Subprogram_Type or else @@ -9497,6 +9519,10 @@ package body Sem_Res is if Ekind (Base_Type (Opnd_Type)) = E_Anonymous_Access_Subprogram_Type and then Is_Entity_Name (Operand) and then Ekind (Entity (Operand)) = E_In_Parameter + and then + (Nkind (Parent (N)) /= N_Assignment_Statement + or else not Is_Entity_Name (Name (Parent (N))) + or else not Is_Return_Object (Entity (Name (Parent (N))))) then Error_Msg_N ("illegal attempt to store anonymous access to subprogram", -- 2.30.2