!standard  7.6(17.1/3)                             10-11-15    AI05-0234-1/00
!class binding interpretation 10-11-15
!status work item 10-11-15
!status received 10-10-31
!priority Low
!difficulty Hard
!qualifier Omission
!subject Hole in AI05-0051-1
!summary


!question

There remains a problem not covered by AI05-0051-1. Consider the following:

   with Text_IO;
   procedure Cw_Alloc is

     type Root is tagged null record;
     type Ref is access Root'Class;

     type Extension (Discrim : access Integer)
       is new Root with null record;

     function Bad_News return Ref is
         Local_Int : aliased Integer := 123;
         Local_Ext : aliased Extension (Discrim => Local_Int'Access);
         type Local_Ref is access all Root'Class;
         for Local_Ref'Storage_Size use 0;
         Local_Ptr : Local_Ref :=  Local_Ext'Access;
     begin
         return new Root'Class'(Local_Ptr.all);
         -- allocator should fail, but RM 4.8(10) doesn't capture this
         -- correctly (with or without the changes of AI05-0051)
     end Bad_News;

     Ptr : Ref := Bad_News;

     procedure Do_Nothing is
     begin
         null;
     end Do_Nothing;
   begin
     Text_IO.Put_Line
       ("*** Test failed - an exception should have been raised");

     Text_IO.Put_Line
       ("    Ptr.Discrim.all ="
          & Integer'Image (Extension (Ptr.all).Discrim.all));

     Do_Nothing;

     Text_IO.Put_Line
       ("    Ptr.Discrim.all ="
          & Integer'Image (Extension (Ptr.all).Discrim.all));
   end Cw_Alloc;


!wording


!discussion


!ACATS Test

From: Steve Baird
Sent: Tuesday, November 2, 2010  8:08 PM

At the recent ARG meeting in Fairfax, we approved AI05-0051 with the
understanding that there remained a known dangling-reference problem involving
allocators which still needs to be addressed.

The following example illustrates the problem:

   with Text_IO;
   procedure Cw_Alloc is

     type Root is tagged null record;
     type Ref is access Root'Class;

     type Extension (Discrim : access Integer)
       is new Root with null record;

     function Bad_News return Ref is
         Local_Int : aliased Integer := 123;
         Local_Ext : aliased Extension (Discrim => Local_Int'Access);
         type Local_Ref is access all Root'Class;
         for Local_Ref'Storage_Size use 0;
         Local_Ptr : Local_Ref :=  Local_Ext'Access;
     begin
         return new Root'Class'(Local_Ptr.all);
         -- allocator should fail, but RM 4.8(10) doesn't capture this
         -- correctly (with or without the changes of AI05-0051)
     end Bad_News;

     Ptr : Ref := Bad_News;

     procedure Do_Nothing is
     begin
         null;
     end Do_Nothing;
   begin
     Text_IO.Put_Line
       ("*** Test failed - an exception should have been raised");

     Text_IO.Put_Line
       ("    Ptr.Discrim.all ="
          & Integer'Image (Extension (Ptr.all).Discrim.all));

     Do_Nothing;

     Text_IO.Put_Line
       ("    Ptr.Discrim.all ="
          & Integer'Image (Extension (Ptr.all).Discrim.all));
   end Cw_Alloc;

Using the Gnat compiler (version 6.3.2) on x86_64 Linux, the following command
    gnatmake cw_alloc.adb -gnat05
produces an executable whose output is

*** Test failed - an exception should have been raised
     Ptr.Discrim.all = 123
     Ptr.Discrim.all = 0

Note that the call to Do_Nothing caused the value of Ptr.Discrim.all to change
from 123 to 0.

This is not a compiler bug - the Gnat compiler is, as far as I know, correctly
implementing all of the checks that the language definition requires for this
example.

The language definition is missing a check in this case.

****************************************************************

From: Tucker Taft
Sent: Tuesday, November 2, 2010  9:36 PM

Do we know whether the same problem might exist for the return statement?  I
think there is some possibility of that.

****************************************************************

From: Steve Baird
Sent: Tuesday, November 2, 2010  9:50 PM

I think you are right; good point. I'll try to flesh this one
out tomorrow, but I see no reason that we won't
run into the same problem.

****************************************************************

From: Steve Baird
Sent: Friday, November 5, 2010  12:33 PM

You are right. Consider the following variation
on the original example:

   with Text_IO;
   procedure Cw_Return is

     type Root is tagged null record;
     type Extension (Discrim : access Integer)
       is new Root with null record;

     function Bad_News return Root'Class is
         Local_Int : aliased Integer := 123;
         Local_Ext : aliased Extension (Discrim => Local_Int'Access);
         type Local_Ref is access all Root'Class;
         for Local_Ref'Storage_Size use 0;
         Local_Ptr : Local_Ref :=  Local_Ext'Access;
     begin
         return Local_Ptr.all;
         -- return should fail, but RM 6.5(21) doesn't capture this
         -- correctly (with or without the changes of AI05-0051)
     end Bad_News;

     Obj : Root'Class := Bad_News;

   begin
     Text_IO.Put_Line
       ("*** Test failed - an exception should have been raised");

     Text_IO.Put_Line
       ("    Obj.Discrim.all ="
          & Integer'Image (Extension (Obj).Discrim.all));
   end Cw_Return;

Compiled and executed as described previously, resulting output is

*** Test failed - an exception should have been raised
     Obj.Discrim.all = 32767

As before, this is not a compiler bug; this is a language definition
problem.

****************************************************************