This patch fixes a compiler abort on an object declaration for a
class-wide type whose expression is a call to an expression function
that returns type extension.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-08-19 Ed Schonberg <schonb...@adacore.com>
gcc/ada/
* sem_res.adb (Resolve_Call): A call to an expression function
freezes when expander is active, unless the call appears within
the body of another expression function,
gcc/testsuite/
* gnat.dg/expr_func9.adb: New testcase.
--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -6314,13 +6314,15 @@ package body Sem_Res is
-- an expression function may appear when it is part of a default
-- expression in a call to an initialization procedure, and must be
-- frozen now, even if the body is inserted at a later point.
+ -- Otherwise, the call freezes the expression if expander is active,
+ -- for example as part of an object declaration.
if Is_Entity_Name (Subp)
and then not In_Spec_Expression
and then not Is_Expression_Function_Or_Completion (Current_Scope)
and then
(not Is_Expression_Function_Or_Completion (Entity (Subp))
- or else Scope (Entity (Subp)) = Current_Scope)
+ or else Expander_Active)
then
if Is_Expression_Function (Entity (Subp)) then
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/expr_func9.adb
@@ -0,0 +1,24 @@
+-- { dg-do compile }
+-- { dg-options "-gnatws" }
+
+procedure Expr_Func9 is
+
+ type Root is interface;
+
+ type Child1 is new Root with null record;
+
+ type Child2 is new Root with record
+ I2 : Integer;
+ end record;
+
+ function Create (I : Integer) return Child2 is (I2 => I);
+
+ I : Root'Class :=
+ (if False
+ then Child1'(null record)
+ else
+ Create (1));
+
+begin
+ null;
+end Expr_Func9;