[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
This commit is contained in:
parent
c702203823
commit
fcef060c9b
|
@ -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>
|
2019-08-19 Dmitriy Anisimkov <anisimko@adacore.com>
|
||||||
|
|
||||||
* libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New
|
* libgnat/s-os_lib.ads, libgnat/s-os_lib.adb (To_Ada, To_C): New
|
||||||
|
|
|
@ -6314,13 +6314,15 @@ package body Sem_Res is
|
||||||
-- an expression function may appear when it is part of a default
|
-- an expression function may appear when it is part of a default
|
||||||
-- expression in a call to an initialization procedure, and must be
|
-- expression in a call to an initialization procedure, and must be
|
||||||
-- frozen now, even if the body is inserted at a later point.
|
-- 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)
|
if Is_Entity_Name (Subp)
|
||||||
and then not In_Spec_Expression
|
and then not In_Spec_Expression
|
||||||
and then not Is_Expression_Function_Or_Completion (Current_Scope)
|
and then not Is_Expression_Function_Or_Completion (Current_Scope)
|
||||||
and then
|
and then
|
||||||
(not Is_Expression_Function_Or_Completion (Entity (Subp))
|
(not Is_Expression_Function_Or_Completion (Entity (Subp))
|
||||||
or else Scope (Entity (Subp)) = Current_Scope)
|
or else Expander_Active)
|
||||||
then
|
then
|
||||||
if Is_Expression_Function (Entity (Subp)) then
|
if Is_Expression_Function (Entity (Subp)) then
|
||||||
|
|
||||||
|
|
|
@ -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>
|
2019-08-19 Bob Duff <duff@adacore.com>
|
||||||
|
|
||||||
* gnat.dg/valid_scalars2.adb: New testcase.
|
* gnat.dg/valid_scalars2.adb: New testcase.
|
||||||
|
|
|
@ -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;
|
Loading…
Reference in New Issue