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 --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 9dbc68b4f04004eae08366188c64dcbe4ac8b49a..e891591a65b9c3dba4617b879505ea2c0245d9fa 100644 (file)
--- 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