[Ada] Compiler abort on call to expr. function for default discriminant

If a discriminant specification has a default that is a call to an
expression function, that function has to be frozen at the point of a
call to the initialization procedure for an object of the record type,
even though the call does not appear to come from source.

2018-08-21  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_res.adb (Resolve_Call): Force the freezing of an
	expression function that is called to provide a default value
	for a defaulted discriminant in an object initialization.

gcc/testsuite/

	* gnat.dg/expr_func5.adb: New testcase.

From-SVN: r263710
This commit is contained in:
Ed Schonberg 2018-08-21 14:44:46 +00:00 committed by Pierre-Marie de Rodat
parent d8251d001b
commit 8a2f6bbe45
4 changed files with 32 additions and 1 deletions

View File

@ -1,3 +1,9 @@
2018-08-21 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Call): Force the freezing of an
expression function that is called to provide a default value
for a defaulted discriminant in an object initialization.
2018-08-21 Hristian Kirtchev <kirtchev@adacore.com>
* libgnat/g-dynhta.adb, libgnat/g-dynhta.ads: New package

View File

@ -6067,7 +6067,10 @@ package body Sem_Res is
-- (including the body of another expression function) which would
-- place the freeze node in the wrong scope. An expression function
-- is frozen in the usual fashion, by the appearance of a real body,
-- or at the end of a declarative part.
-- or at the end of a declarative part. However an implcit call to
-- an expression function may appear when it is part of a default
-- expression in a call to an initialiation procedure, and must be
-- frozen now, even if the body is inserted at a later point.
if Is_Entity_Name (Subp)
and then not In_Spec_Expression
@ -6076,6 +6079,14 @@ package body Sem_Res is
(not Is_Expression_Function_Or_Completion (Entity (Subp))
or else Scope (Entity (Subp)) = Current_Scope)
then
if Is_Expression_Function (Entity (Subp)) then
-- Force freeze of expression function in call.
Set_Comes_From_Source (Subp, True);
Set_Must_Not_Freeze (Subp, False);
end if;
Freeze_Expression (Subp);
end if;

View File

@ -1,3 +1,7 @@
2018-08-21 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/expr_func5.adb: New testcase.
2018-08-21 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/dynhash.adb: New testcase.

View File

@ -0,0 +1,10 @@
-- { dg-do compile }
procedure Expr_Func5 is
type T is (B);
function F return T is (B);
type R (W : T := F) is null record;
V : R;
begin
null;
end Expr_Func5;