From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Thread: 103376,fb264cdd67c2f20f
X-Google-Attributes: gid103376,public
X-Google-Language: ENGLISH,ASCII-7-bit
Newsgroups: comp.lang.ada
Subject: A smaller self contained test case. Was: Compiler Bug or what I'm
 doing wrong?
References: <05lkrrojfd.fsf@hod.lan.m-e-leypold.de>
From: M E Leypold
 <development-2006-8ecbb5cc8aREMOVETHIS@ANDTHATm-e-leypold.de>
Date: 23 Jun 2006 11:55:23 +0200
Message-ID: <t3k678yz5g.fsf@hod.lan.m-e-leypold.de>
MIME-Version: 1.0
Content-Type: text/plain; charset=us-ascii
User-Agent: Some cool user agent (SCUG)
NNTP-Posting-Host: 88.72.221.30
X-Trace: news.arcor-ip.de 1151056166 88.72.221.30 (23 Jun 2006 11:49:26 +0200)
X-Complaints-To: abuse@arcor-ip.de
Path: 
 g2news2.google.com!news4.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!newsfeed.arcor-ip.de!news.arcor-ip.de!not-for-mail
Xref: g2news2.google.com comp.lang.ada:4953
Date: 2006-06-23T11:55:23+02:00
List-Id: <comp.lang.ada>



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