From: Denis Mazzucato <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 9dbc68b4f04..e891591a65b 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
--
2.53.0
