diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2019-08-19 08:37:18 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-08-19 08:37:18 +0000 |
| commit | fcef060c9b321edcb24a56616588e712c22029ba (patch) | |
| tree | fa2ac7b8b70693305f9e74b04b5dac7f11a2c259 | |
| parent | c70220382300ae326ad63fe54c5a32da202d1f13 (diff) | |
| download | gcc-fcef060c9b321edcb24a56616588e712c22029ba.zip gcc-fcef060c9b321edcb24a56616588e712c22029ba.tar.gz gcc-fcef060c9b321edcb24a56616588e712c22029ba.tar.bz2 | |
[Ada] Crash on object initialization that is call to expression function
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.
2019-08-19 Ed Schonberg <schonberg@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.
From-SVN: r274662
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 4 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/expr_func9.adb | 24 |
4 files changed, 37 insertions, 1 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 932ff97..1f490b3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-08-19 Ed Schonberg <schonberg@adacore.com> + + * 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, + 2019-08-19 Dmitriy Anisimkov <anisimko@adacore.com> * libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8f2e358..7a52b90 100644 --- a/gcc/ada/sem_res.adb +++ b/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 127a223..2dd707d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-08-19 Ed Schonberg <schonberg@adacore.com> + + * gnat.dg/expr_func9.adb: New testcase. + 2019-08-19 Bob Duff <duff@adacore.com> * gnat.dg/valid_scalars2.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/expr_func9.adb b/gcc/testsuite/gnat.dg/expr_func9.adb new file mode 100644 index 0000000..4bfa21d --- /dev/null +++ b/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; |