Comments
Patch
===================================================================
@@ -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;
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 <schonberg@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.