In certain cases the object designated by an access discriminant can be stack-
allocated, for example when the enclosing object is a local object declaration.
However, if the access discriminant is an aggregate component of a return
expression or a return object, it must be allocated dynamically.
The following must output
42
84
---
gnatmake -q -gnat05 test_driver
test_driver
---
with test_package;
with Text_IO;
procedure test_driver is
begin
declare
foo : test_package.test_type := test_package.get (-1);
bar : access Integer := new Integer'(69);
begin
Text_IO.Put_Line(foo.p_obj.all'img);
end;
declare
foo : test_package.test_type := test_package.get (42);
bar : access Integer := new Integer'(1234);
begin
Text_IO.Put_Line(foo.p_obj.all'img);
end;
end test_driver;
---
package test_package is
type test_type (p_obj : access Integer) is limited private;
function get (X : Integer) return test_type;
private
type test_type (p_obj : access Integer) is limited null record;
end test_package;
---
package body test_package is
function get (X : Integer) return test_type is
begin
if X < 0 then
return test_type'(p_obj => new Integer'(42));
else
return result : test_Type := (p_obj => new Integer'(2 * X));
end if;
end get;
end test_package;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-12-21 Ed Schonberg <schonb...@adacore.com>
* sem_util.adb (Mark_Coextensions): A coextension for an
object that is part of the expression in a return statement,
or part of the return object in an extended return statement,
must be allocated dynamically.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 182572)
+++ sem_util.adb (working copy)
@@ -9331,7 +9331,6 @@
and then Nkind (Expression (Expression (N))) = N_Op_Concat
then
Set_Is_Dynamic_Coextension (N);
-
else
Set_Is_Static_Coextension (N);
end if;
@@ -9346,12 +9345,33 @@
begin
case Nkind (Context_Nod) is
- when N_Assignment_Statement |
- N_Simple_Return_Statement =>
+
+ -- Comment here ???
+
+ when N_Assignment_Statement =>
Is_Dynamic := Nkind (Expression (Context_Nod)) = N_Allocator;
+ -- An allocator that is a component of a returned aggregate
+ -- must be dynamic.
+
+ when N_Simple_Return_Statement =>
+ declare
+ Expr : constant Node_Id := Expression (Context_Nod);
+ begin
+ Is_Dynamic :=
+ Nkind (Expr) = N_Allocator
+ or else
+ (Nkind (Expr) = N_Qualified_Expression
+ and then Nkind (Expression (Expr)) = N_Aggregate);
+ end;
+
+ -- An alloctor within an object declaration in an extended return
+ -- statement is of necessity dynamic.
+
when N_Object_Declaration =>
- Is_Dynamic := Nkind (Root_Nod) = N_Allocator;
+ Is_Dynamic := Nkind (Root_Nod) = N_Allocator
+ or else
+ Nkind (Parent (Context_Nod)) = N_Extended_Return_Statement;
-- This routine should not be called for constructs which may not
-- contain coextensions.
@@ -9371,9 +9391,9 @@
Formal : Entity_Id;
begin
- if Ada_Version >= Ada_2005
- and then Present (First_Formal (E))
- then
+ -- Ada 2005 or later, and formals present
+
+ if Ada_Version >= Ada_2005 and then Present (First_Formal (E)) then
Formal := Next_Formal (First_Formal (E));
while Present (Formal) loop
if No (Default_Value (Formal)) then
@@ -9385,6 +9405,8 @@
return True;
+ -- Ada 83/95 or no formals
+
else
return False;
end if;
