[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 <schonberg@adacore.com> 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
This commit is contained in:
parent
f56add9cb0
commit
890cde5319
|
@ -1,3 +1,9 @@
|
|||
2019-09-19 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* 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 <duff@adacore.com>
|
||||
|
||||
* sem_attr.adb (Resolve_Attribute): Make sure the secondary
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2019-09-19 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* gnat.dg/predicate14.adb, gnat.dg/predicate14.ads: New
|
||||
testcase.
|
||||
|
||||
2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/generic_inst13.adb,
|
||||
|
|
|
@ -0,0 +1,4 @@
|
|||
-- { dg-do compile }
|
||||
package body Predicate14 is
|
||||
procedure Dummy is null;
|
||||
end Predicate14;
|
|
@ -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;
|
Loading…
Reference in New Issue