[Bug ada/58264] New: Incorrect 'First when assigning function-call.all (of access String;) to an indefinite String object

[hans.buhrer at lmco dot com]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=58264

            Bug ID: 58264
           Summary: Incorrect 'First when assigning function-call.all (of
                    access String;) to an indefinite String object
           Product: gcc
           Version: 4.6.3
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
          Assignee: unassigned at gcc dot gnu.org
          Reporter: hans.buhrer at lmco dot com

Created attachment 30713
  --> http://gcc.gnu.org/bugzilla/attachment.cgi?id=30713&action=edit
Minimal Ada source to reproduce the problem

In the source below, the function Peek returns a pointer to a
(formally)unconstrained String. The actual lower bound of the dynamically
allocated String object is 1.
When Peek.all is assigned to an indefinite String variable, the dope vector is
apparently not copied, but the dynamically allocated dope vector is reused.
When the dynamically allocated object is then Free'd (including its dope
vector) the 'First of the indefinite string object turns to garbage (0).
This only seems to happen for pointer-to-String that are returned by a function
call.
----------
with Ada.Text_Io;
with Ada.Unchecked_Deallocation;
procedure Failure is

  type String_Ptr_T is access String;
  procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr_T);
  String_Data : String_Ptr_T := new String'("Hello World");

  function Peek return String_Ptr_T is
  begin
    return String_Data;
  end Peek;

begin
  declare
    Corrupted_String : String := Peek.all; -- Fails
--    Corrupted_String : String := String_Data.all;  -- Works
  begin
    Ada.Text_Io.Put_Line(Integer'Image(Corrupted_String'First));
    Free(String_Data);
    Ada.Text_Io.Put_Line(Integer'Image(Corrupted_String'First));
  end;
end Failure;
----------

elvm1>gnatmake -O0 -g failure.adb -cargs -v -save-temps -Wall -Wextra
gcc-4.6 -c -O0 -g -v -save-temps -Wall -Wextra failure.adb
Using built-in specs.
COLLECT_GCC=/usr//bin/gcc-4.6
COLLECT_LTO_WRAPPER=/usr/lib/gcc/i686-linux-gnu/4.6/lto-wrapper
Target: i686-linux-gnu
Configured with: ../src/configure -v --with-pkgversion='Ubuntu/Linaro
4.6.3-1ubuntu5' --with-bugurl=file:///usr/share/doc/gcc-4.6/README.Bugs
--enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr
--program-suffix=-4.6 --enable-shared --enable-linker-build-id
--with-system-zlib --libexecdir=/usr/lib --without-included-gettext
--enable-threads=posix --with-gxx-include-dir=/usr/include/c++/4.6
--libdir=/usr/lib --enable-nls --with-sysroot=/ --enable-clocale=gnu
--enable-libstdcxx-debug --enable-libstdcxx-time=yes --enable-gnu-unique-object
--enable-plugin --enable-objc-gc --enable-targets=all --disable-werror
--with-arch-32=i686 --with-tune=generic --enable-checking=release
--build=i686-linux-gnu --host=i686-linux-gnu --target=i686-linux-gnu
Thread model: posix
gcc version 4.6.3 (Ubuntu/Linaro 4.6.3-1ubuntu5) 
COLLECT_GCC_OPTIONS='-gnatea' '-c' '-O0' '-g' '-v' '-save-temps' '-Wall'
'-Wextra' '-gnatez' '-mtune=generic' '-march=i686'
 /usr/lib/gcc/i686-linux-gnu/4.6/gnat1 -gnatwa -quiet -dumpbase failure.adb
-auxbase failure -O0 -Wall -Wextra -gnatez -gnatea -g -gnatez -mtune=generic
-march=i686 failure.adb -o failure.s
failure.adb:16:05: warning: "Corrupted_String" is not modified, could be
declared constant
COLLECT_GCC_OPTIONS='-gnatea' '-c' '-O0' '-g' '-v' '-save-temps' '-Wall'
'-Wextra' '-gnatez' '-mtune=generic' '-march=i686'
 as --32 -o failure.o failure.s
COMPILER_PATH=/usr/lib/gcc/i686-linux-gnu/4.6/:/usr/lib/gcc/i686-linux-gnu/4.6/:/usr/lib/gcc/i686-linux-gnu/:/usr/lib/gcc/i686-linux-gnu/4.6/:/usr/lib/gcc/i686-linux-gnu/
LIBRARY_PATH=/usr/lib/gcc/i686-linux-gnu/4.6/:/usr/lib/gcc/i686-linux-gnu/4.6/../../../i386-linux-gnu/:/usr/lib/gcc/i686-linux-gnu/4.6/../../../../lib/:/lib/i386-linux-gnu/:/lib/../lib/:/usr/lib/i386-linux-gnu/:/usr/lib/../lib/:/usr/lib/gcc/i686-linux-gnu/4.6/../../../:/lib/:/usr/lib/
COLLECT_GCC_OPTIONS='-gnatea' '-c' '-O0' '-g' '-v' '-save-temps' '-Wall'
'-Wextra' '-gnatez' '-mtune=generic' '-march=i686'
gnatbind -x failure.ali
gnatlink failure.ali -O0 -g
elvm1>./failure
 1
 0

As a work around, using 

Corrupted_String : String := Peek.all & ""; 

helps.