[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:
Ed Schonberg 2019-09-19 08:13:20 +00:00 committed by Pierre-Marie de Rodat
parent f56add9cb0
commit 890cde5319
5 changed files with 95 additions and 8 deletions

View File

@ -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

View File

@ -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,

View File

@ -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,

View File

@ -0,0 +1,4 @@
-- { dg-do compile }
package body Predicate14 is
procedure Dummy is null;
end Predicate14;

View File

@ -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;