This patch fixes a crash on an expression function that is a completion, when the return expression includes a reference to a discriminant-dependent component. An expression function that is a completion freezes all types referenced in the expression, but some itypes are excluded because they are frozen elsewhere (in the case pf discriminant-dependent component, when the type itself is frozen).
Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ 2017-12-15 Ed Schonberg <schonb...@adacore.com> * sem_ch6.adb (Freeze_Expr_Types): Do not emit a freeze node for an itype that is the type of a discriminant-dependent component. Fixes QC04-017. gcc/testsuite/ 2017-12-15 Ed Schonberg <schonb...@adacore.com> * gnat.dg/expr_func2.ads, gnat.dg/expr_func2.adb: New testcase.
Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 255683) +++ sem_ch6.adb (working copy) @@ -366,10 +366,13 @@ procedure Check_And_Freeze_Type (Typ : Entity_Id) is begin - -- Skip Itypes created by the preanalysis + -- Skip Itypes created by the preanalysis, and itypes + -- whose scope is another type (i.e. component subtypes + -- that depend on a discriminant), if Is_Itype (Typ) - and then Scope_Within_Or_Same (Scope (Typ), Def_Id) + and then (Scope_Within_Or_Same (Scope (Typ), Def_Id) + or else Is_Type (Scope (Typ))) then return; end if; Index: ../testsuite/gnat.dg/expr_func2.ads =================================================================== --- ../testsuite/gnat.dg/expr_func2.ads (revision 0) +++ ../testsuite/gnat.dg/expr_func2.ads (revision 0) @@ -0,0 +1,22 @@ +package Expr_Func2 is + + type T_Index is range 1 .. 255; + + type T_Table is array (T_Index range <>) of Boolean; + + type T_Variable_Table (N : T_Index := T_Index'First) is record + Table : T_Table (1 .. N); + end record; + + type T_A_Variable_Table is access T_Variable_Table; + + function Element (A_Variable_Table : T_A_Variable_Table) return Boolean; + +private + + function Element (A_Variable_Table : T_A_Variable_Table) return Boolean is + (A_Variable_Table.all.Table (1)); + + procedure Foo; + +end Expr_Func2; Index: ../testsuite/gnat.dg/expr_func2.adb =================================================================== --- ../testsuite/gnat.dg/expr_func2.adb (revision 0) +++ ../testsuite/gnat.dg/expr_func2.adb (revision 0) @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Expr_Func2 is + procedure Foo is null; +end Expr_Func2;