A smaller self contained test case. Was: Compiler Bug or what I'm doing wrong?

[M E Leypold <development-2006-8ecbb5cc8aREMOVETHIS@ANDTHATm-e-leypold.de>]

Dear All,

I'm attaching a smaller (and now self contained test case!) for the
SIGSEGV whil reading/writing varaint records which I wrote about
earlier.

Some data:

 1. Gnat 3.15p on Debian Sarge.
 2. Running the attached program wil result in a SIGSEGV in a finalizer.

I'm also attaching a short backtrace.

Regards -- Markus


---


     with Ada.Streams.Stream_IO; use  Ada.Streams.Stream_IO;
     with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;

     procedure Demo.Bug3 is

        type Customer_Description( Is_Company : Boolean := True ) is record

           case Is_Company Is

              when  True   =>

                 Foo                 : Integer := 0;       -- remove these and the
                 Bar                 : Integer := 0;       -- SIGSEGV goes away
                 Company_Name        : Unbounded_String ;

              when  False  =>

                 Persons_Name        : Unbounded_String;

              when   others  =>  null;
           end case;
        end record;


        procedure Set_Zugang ( D :  in out Customer_Description ; Z : Boolean ) is begin

           if Z /= D.Is_Company then

              case Z is

                 when True      =>
                    declare New_D : Customer_Description(True);
                    begin
                       D := New_D ;
                    end;

                 when False  =>
                    declare New_D : Customer_Description(False);
                    begin   D := New_D ; end;

              end case;
           end if;
        end;


        procedure Write_Record
        is
          F : File_Type;
          S : Stream_Access;
          R : Customer_Description;
        begin
           Create( F , Name => "tmp-bug3" );
           S := Stream(F);
           Set_Zugang(R, False);                   -- remove this and the SIGSEGV goes away

           for I in 1 .. 400 loop
              Customer_Description'Write(S,R);     -- [1a]
           end loop;

           Close(F);
        end;


        procedure Get_Record
        is
           F : File_Type;
           S : Stream_Access;
        begin

           Open( F , Mode => In_File, Name => "tmp-bug3" );
           S := Stream(F);

           for I in 1 .. 400 loop
              declare R : Customer_Description;
              begin
                 Customer_Description'Read(S,R);        -- [1b]
              end;
           end loop;

           Close( F );
        end;

        R : Customer_Description;

     begin
        Write_Record;
        Get_Record;
     end;


---


Program received signal SIGSEGV, Segmentation fault.
0x408d1d41 in system__finalization_implementation__finalize_list ()
   from /usr/lib/libgnat-3.15p.so.1
#0  0x408d1d41 in system__finalization_implementation__finalize_list ()
   from /usr/lib/libgnat-3.15p.so.1
#1  0x408d1bdc in system__finalization_implementation__finalize ()
   from /usr/lib/libgnat-3.15p.so.1
#2  0x408d1d47 in system__finalization_implementation__finalize_list ()
   from /usr/lib/libgnat-3.15p.so.1
#3  0x0804cef9 in demo__bug3__get_record__B_4___clean.21 ()
#4  0x0804dec7 in demo.bug3.get_record () at demo-bug3.adb:77
#5  0x0804e203 in demo.bug3 () at demo-bug3.adb:88
#6  0x0804b4ad in main (argc=1, argv=(system.address) 0xbffff8a4,
    envp=(system.address) 0xbffff8ac) at b~demo-bug3.adb:180
#7  0x40930e36 in __libc_start_main () from /lib/libc.so.6