https://gcc.gnu.org/g:6ba4e5dff52b0773719525bb5eb78b04cfe985e5
commit r17-855-g6ba4e5dff52b0773719525bb5eb78b04cfe985e5 Author: Denis Mazzucato <[email protected]> Date: Wed Feb 18 14:35:55 2026 +0100 ada: Fix crash evaluating class-wide preconditions with missing completion This patch fixes a crash occurring when evaluating class-wide precondition of a non-primitive subprogram where accessing the class-wide type of its dispatching type is not possible. The bug occurs when the type is abstract and missing completion, a proper error should be given instead. gcc/ada/ChangeLog: * sem_prag.adb (Check_References): Don't call Class_Wide_Type if the subprogram is a non-primitive procedure as the dispatching type may be empty. Diff: --- gcc/ada/sem_prag.adb | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 9dbc68b4f040..e891591a65b9 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -29227,6 +29227,10 @@ package body Sem_Prag is ---------------------- function Check_References (Nod : Node_Id) return Traverse_Result is + CW_Disp_Typ : constant Entity_Id := + (if Present (Disp_Typ) + then Class_Wide_Type (Disp_Typ) + else Empty); begin if Nkind (Nod) = N_Function_Call and then Is_Entity_Name (Name (Nod)) @@ -29253,7 +29257,7 @@ package body Sem_Prag is -- A return object of the type is illegal as well if Etype (Func) = Disp_Typ - or else Etype (Func) = Class_Wide_Type (Disp_Typ) + or else Etype (Func) = CW_Disp_Typ then Error_Msg_NE ("operation in class-wide condition must be primitive " @@ -29265,7 +29269,7 @@ package body Sem_Prag is elsif Is_Entity_Name (Nod) and then (Etype (Nod) = Disp_Typ - or else Etype (Nod) = Class_Wide_Type (Disp_Typ)) + or else Etype (Nod) = CW_Disp_Typ) and then Ekind (Entity (Nod)) in E_Constant | E_Variable then Error_Msg_NE @@ -29274,7 +29278,7 @@ package body Sem_Prag is elsif Nkind (Nod) = N_Explicit_Dereference and then (Etype (Nod) = Disp_Typ - or else Etype (Nod) = Class_Wide_Type (Disp_Typ)) + or else Etype (Nod) = CW_Disp_Typ) and then (not Is_Entity_Name (Prefix (Nod)) or else not Is_Formal (Entity (Prefix (Nod)))) then
