https://gcc.gnu.org/g:143a0d9ec6f814cf49ca116780bfe67ba6307486
commit r17-877-g143a0d9ec6f814cf49ca116780bfe67ba6307486 Author: Javier Miranda <[email protected]> Date: Mon Mar 2 16:24:01 2026 +0000 ada: Incorrect error message on use of 'Result with wrong prefix gcc/ada/ChangeLog: * sem_util.ads (Is_Access_Subprogram_Wrapper): Renamed as Is_Access_To_Subprogram_Wrapper. * sem_util.adb (Is_Access_Subprogram_Wrapper): Ditto plus add assertion. * sem_disp.adb (Is_Access_To_Subprogram_Wrapper): Removed. * sem_prag.adb (Find_Related_Declaration_Or_Body): Replace call to Is_Access_Subprogram_Wrapper by call to Is_Access_To_Subprogram_Wrapper. * exp_ch6.adb (Expand_Call): Ditto. * sem_attr.adb (Analyze_Attribute [Attribute_Result]): For access to subprogram wrappers, report that the expected prefix is the name of the access type. Diff: --- gcc/ada/exp_ch6.adb | 4 ++-- gcc/ada/sem_attr.adb | 19 +++++++++++++++++-- gcc/ada/sem_disp.adb | 22 +--------------------- gcc/ada/sem_prag.adb | 2 +- gcc/ada/sem_util.adb | 30 ++++++++++++++++++++---------- gcc/ada/sem_util.ads | 2 +- 6 files changed, 42 insertions(+), 37 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7a6f9567f874..5ae609c47e48 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2812,10 +2812,10 @@ package body Exp_Ch6 is if Must_Rewrite_Indirect_Call and then (not Is_Overloadable (Current_Scope) - or else not (Is_Access_Subprogram_Wrapper (Current_Scope) + or else not (Is_Access_To_Subprogram_Wrapper (Current_Scope) or else (Chars (Current_Scope) = Name_uWrapped_Statements - and then Is_Access_Subprogram_Wrapper + and then Is_Access_To_Subprogram_Wrapper (Scope (Current_Scope))))) then declare diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 2dd502f21bc2..8033506108a8 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -6176,7 +6176,13 @@ package body Sem_Attr is -- Otherwise the prefix denotes some unrelated function else - Error_Msg_Name_2 := Chars (Spec_Id); + if Is_Access_To_Subprogram_Wrapper (Spec_Id) then + Error_Msg_Name_2 := + Chars (Etype (Last_Formal (Spec_Id))); + else + Error_Msg_Name_2 := Chars (Spec_Id); + end if; + Error_Attr ("incorrect prefix for attribute %, expected %", P); end if; @@ -6187,8 +6193,17 @@ package body Sem_Attr is elsif Is_Access_Subprogram_Type (Pref_Id) then if Pref_Id = Spec_Id then Set_Etype (N, Etype (Designated_Type (Spec_Id))); + + -- Otherwise the prefix denotes some unrelated function + else - Error_Msg_Name_2 := Chars (Spec_Id); + if Is_Access_To_Subprogram_Wrapper (Spec_Id) then + Error_Msg_Name_2 := + Chars (Etype (Last_Formal (Spec_Id))); + else + Error_Msg_Name_2 := Chars (Spec_Id); + end if; + Error_Attr ("incorrect prefix for attribute %, expected %", P); end if; diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index ac9042ccc58e..dfcf384c7dae 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1199,8 +1199,6 @@ package body Sem_Disp is --------------------------------- procedure Check_Dispatching_Operation (Subp, Old_Subp : Entity_Id) is - function Is_Access_To_Subprogram_Wrapper (E : Entity_Id) return Boolean; - -- Return True if E is an access to subprogram wrapper procedure Warn_On_Late_Primitive_After_Private_Extension (Typ : Entity_Id; @@ -1209,22 +1207,6 @@ package body Sem_Disp is -- if it is a public primitive defined after some private extension of -- the tagged type. - ------------------------------------- - -- Is_Access_To_Subprogram_Wrapper -- - ------------------------------------- - - function Is_Access_To_Subprogram_Wrapper (E : Entity_Id) return Boolean - is - Decl_N : constant Node_Id := Unit_Declaration_Node (E); - Par_N : constant Node_Id := Parent (List_Containing (Decl_N)); - - begin - -- Access to subprogram wrappers are declared in the freezing actions - - return Nkind (Par_N) = N_Freeze_Entity - and then Ekind (Entity (Par_N)) = E_Access_Subprogram_Type; - end Is_Access_To_Subprogram_Wrapper; - ---------------------------------------------------- -- Warn_On_Late_Primitive_After_Private_Extension -- ---------------------------------------------------- @@ -1298,9 +1280,7 @@ package body Sem_Disp is -- Wrappers of access to subprograms are not primitive subprograms. - elsif Is_Wrapper (Subp) - and then Is_Access_To_Subprogram_Wrapper (Subp) - then + elsif Is_Access_To_Subprogram_Wrapper (Subp) then return; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3519f9166e61..e3f1ed0e0856 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -34170,7 +34170,7 @@ package body Sem_Prag is then return Stmt; - elsif Is_Access_Subprogram_Wrapper (Defining_Entity (Stmt)) + elsif Is_Access_To_Subprogram_Wrapper (Defining_Entity (Stmt)) and then Ada_Version >= Ada_2022 then return Stmt; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 8119fa43d64f..7d6e0fc7d8ac 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12747,18 +12747,28 @@ package body Sem_Util is return False; end Has_Non_Null_Statements; - ---------------------------------- - -- Is_Access_Subprogram_Wrapper -- - ---------------------------------- + ------------------------------------- + -- Is_Access_To_Subprogram_Wrapper -- + ------------------------------------- + + function Is_Access_To_Subprogram_Wrapper (E : Entity_Id) return Boolean is + Formal : Entity_Id; - function Is_Access_Subprogram_Wrapper (E : Entity_Id) return Boolean is - Formal : constant Entity_Id := Last_Formal (E); begin - return Present (Formal) - and then Ekind (Etype (Formal)) in Access_Subprogram_Kind - and then Access_Subprogram_Wrapper - (Directly_Designated_Type (Etype (Formal))) = E; - end Is_Access_Subprogram_Wrapper; + if not Is_Wrapper (E) + or else not Can_Have_Formals (E) + or else No (Last_Formal (E)) + then + return False; + + else + Formal := Last_Formal (E); + + return Ekind (Etype (Formal)) in Access_Subprogram_Kind + and then Access_Subprogram_Wrapper + (Directly_Designated_Type (Etype (Formal))) = E; + end if; + end Is_Access_To_Subprogram_Wrapper; --------------------------- -- Is_Explicitly_Aliased -- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 6118e27bc2de..fc1845e0b490 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1881,7 +1881,7 @@ package Sem_Util is -- pragma Initialize_Scalars or by the binder. Return an expression created -- at source location Loc, which denotes the invalid value. - function Is_Access_Subprogram_Wrapper (E : Entity_Id) return Boolean; + function Is_Access_To_Subprogram_Wrapper (E : Entity_Id) return Boolean; -- True if E is the constructed wrapper for an access_to_subprogram -- type with Pre/Postconditions.
