From 890cde5319470afab7e96e3b7953075681c015f5 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 19 Sep 2019 08:13:20 +0000 Subject: [PATCH] [Ada] Crash on predicate in full view in a generic unit This patch fixes a compiler abort on a dynamic predicate applied to the full view of a type in a generic package declaration, when the expression for the predicate is a conditionql expression that contains references to components of the full view of the type. 2019-09-19 Ed Schonberg gcc/ada/ * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Simplify handling of expressions in predicates when the context is a generic unit. gcc/testsuite/ * gnat.dg/predicate14.adb, gnat.dg/predicate14.ads: New testcase. From-SVN: r275939 --- gcc/ada/ChangeLog | 6 +++ gcc/ada/sem_ch13.adb | 32 +++++++++++---- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gnat.dg/predicate14.adb | 4 ++ gcc/testsuite/gnat.dg/predicate14.ads | 56 +++++++++++++++++++++++++++ 5 files changed, 95 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/predicate14.adb create mode 100644 gcc/testsuite/gnat.dg/predicate14.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b3e94dbf5dc..2caf52da59d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-09-19 Ed Schonberg + + * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Simplify + handling of expressions in predicates when the context is a + generic unit. + 2019-09-19 Bob Duff * sem_attr.adb (Resolve_Attribute): Make sure the secondary diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index ef9f965a564..354d068117a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9374,17 +9374,22 @@ package body Sem_Ch13 is else -- In a generic context freeze nodes are not always generated, so - -- analyze the expression now. If the aspect is for a type, this - -- makes its potential components accessible. + -- analyze the expression now. If the aspect is for a type, we must + -- also make its potential components accessible. if not Analyzed (Freeze_Expr) and then Inside_A_Generic then if A_Id = Aspect_Dynamic_Predicate or else A_Id = Aspect_Predicate - or else A_Id = Aspect_Priority then Push_Type (Ent); - Preanalyze_Spec_Expression (Freeze_Expr, T); + Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean); + Pop_Type (Ent); + + elsif A_Id = Aspect_Priority then + Push_Type (Ent); + Preanalyze_Spec_Expression (Freeze_Expr, Any_Integer); Pop_Type (Ent); + else Preanalyze (Freeze_Expr); end if; @@ -9395,12 +9400,23 @@ package body Sem_Ch13 is Set_Parent (End_Decl_Expr, ASN); - -- In a generic context the aspect expressions have not been - -- preanalyzed, so do it now. There are no conformance checks - -- to perform in this case. + -- In a generic context the original aspect expressions have not + -- been preanalyzed, so do it now. There are no conformance checks + -- to perform in this case. As before, we have to make components + -- visible for aspects that may reference them. if No (T) then - Check_Aspect_At_Freeze_Point (ASN); + if A_Id = Aspect_Dynamic_Predicate + or else A_Id = Aspect_Predicate + or else A_Id = Aspect_Priority + then + Push_Type (Ent); + Check_Aspect_At_Freeze_Point (ASN); + Pop_Type (Ent); + + else + Check_Aspect_At_Freeze_Point (ASN); + end if; return; -- The default values attributes may be defined in the private part, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 69e78548ab8..7cde63d60b9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-09-19 Ed Schonberg + + * gnat.dg/predicate14.adb, gnat.dg/predicate14.ads: New + testcase. + 2019-09-19 Eric Botcazou * gnat.dg/generic_inst13.adb, diff --git a/gcc/testsuite/gnat.dg/predicate14.adb b/gcc/testsuite/gnat.dg/predicate14.adb new file mode 100644 index 00000000000..3caf7a4412d --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate14.adb @@ -0,0 +1,4 @@ +-- { dg-do compile } +package body Predicate14 is + procedure Dummy is null; +end Predicate14; diff --git a/gcc/testsuite/gnat.dg/predicate14.ads b/gcc/testsuite/gnat.dg/predicate14.ads new file mode 100644 index 00000000000..9ed6c86270f --- /dev/null +++ b/gcc/testsuite/gnat.dg/predicate14.ads @@ -0,0 +1,56 @@ +generic +package Predicate14 with + SPARK_Mode +is + + type Field_Type is (F_Initial, F_Payload, F_Final); + + type State_Type is (S_Valid, S_Invalid); + + type Cursor_Type (State : State_Type := S_Invalid) is private; + + type Cursors_Type is array (Field_Type) of Cursor_Type; + + type Context_Type is private; + + type Result_Type (Field : Field_Type := F_Initial) is + record + case Field is + when F_Initial | F_Final => + null; + when F_Payload => + Value : Integer; + end case; + end record; + + function Valid_Context (Context : Context_Type) return Boolean; + +private + + function Valid_Type (Result : Result_Type) return Boolean is + (Result.Field = F_Initial); + + type Cursor_Type (State : State_Type := S_Invalid) is + record + case State is + when S_Valid => + Value : Result_Type; + when S_Invalid => + null; + end case; + end record + with Dynamic_Predicate => + (if State = S_Valid then Valid_Type (Value)); + + type Context_Type is + record + Field : Field_Type := F_Initial; + Cursors : Cursors_Type := (others => (State => S_Invalid)); + end record; + + function Valid_Context (Context : Context_Type) return Boolean is + (for all F in Context.Cursors'Range => + (Context.Cursors (F).Value.Field = F)); + + procedure Dummy; +end Predicate14; \ No newline at end of file -- 2.30.2