https://gcc.gnu.org/g:4b21fdfc7ce65281d999b1fa48de087e94c7be0a
commit r16-8998-g4b21fdfc7ce65281d999b1fa48de087e94c7be0a 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 18fd7b7be3e1..8c3746e94abb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -29128,6 +29128,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)) @@ -29154,7 +29158,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 " @@ -29166,7 +29170,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 @@ -29175,7 +29179,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
