[Bug ada/42140] GNAT appears to misbehave with limited tagged types and possibly finalization

[gcc at coreland dot ath dot cx]

------- Comment #2 from gcc at coreland dot ath dot cx  2009-11-22 16:41 -------
A couple of people have commented on the anonymous access type
(claiming it causes the crash). Here's a version with it removed
and a gdb backtrace:

Program received signal SIGSEGV, Segmentation fault.
system.finalization_implementation.move_final_list (from=0x800a02040, to=0x0)
at s-finimp.adb:486
486     s-finimp.adb: No such file or directory.
        in s-finimp.adb
(gdb) bt
#0  system.finalization_implementation.move_final_list (from=0x800a02040,
to=0x0) at s-finimp.adb:486
#1  0x0000000000402cfb in archiver.open_archive (archiver=(), path=0x41fe18,
<open_archiveBIPalloc>=4324888, 
    <open_archiveBIPfinallist>=0x0, <open_archiveBIPaccess>=0x7fffffffe6d8) at
archiver.adb:9
#2  0x0000000000402e9f in main () at main.adb:9

Probably advisable to add an assertion in Move_Final_List
to ensure that 'To' is not null.

-- %< archiver.ads

with Ada.Finalization;
with Ada.Streams.Stream_IO;

package Archiver is

  type Archiver_t is tagged limited private;
  type Archive_t  is tagged limited private;

  function Open_Archive
    (Archiver : in Archiver_t;
     Path     : in String) return Archive_t'Class;

  function Stream
    (Archive : in Archive_t)
      return Ada.Streams.Stream_IO.Stream_Access;

private
  package Stream_IO renames Ada.Streams.Stream_IO;

  type Archiver_t is tagged limited null record;

  type Archive_t is new Ada.Finalization.Limited_Controlled with record
    File : Stream_IO.File_Type;
  end record;

end Archiver;

-- %< archiver.adb

package body Archiver is

  function Open_Archive
    (Archiver : in Archiver_t;
     Path     : in String) return Archive_t'Class
  is
    pragma Unreferenced (Archiver);
  begin
    return A : Archive_t'Class :=
Archive_t'(Ada.Finalization.Limited_Controlled with others => <>) do
      Stream_IO.Open
        (Name => Path,
         File => A.File,
         Mode => Stream_IO.In_File);
    end return;
  end Open_Archive;

  function Stream
    (Archive : in Archive_t)
      return Ada.Streams.Stream_IO.Stream_Access is
  begin
    return Stream_IO.Stream (Archive.File);
  end Stream;

end Archiver;

-- %< main.adb

with Ada.Text_IO;
with Ada.Streams.Stream_IO;
with Archiver;

procedure Main is

  A : Archiver.Archiver_t;
  S : constant Ada.Streams.Stream_IO.Stream_Access := Archiver.Stream
(Archiver.Open_Archive (A, "file.zip"));
  X : Integer;

begin
  X := Integer'Input (S);

  Ada.Text_IO.Put_Line (Integer'Image (X));
end Main;


-- 


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