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

["Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de>]

On 24 Jun 2006 15:53:32 +0200, M E Leypold wrote:

> "Dmitry A. Kazakov" <mailbox@dmitry-kazakov.de> writes:
> 
>> BTW, I wouldn't use discriminants with defaults, 
> 
> I'm perhaps misuing dicriminants anyway in that application. But they
> need to have defaults, since the disriminated records are fields in
> another record. Like
> 
>   type All_We_Know ( Internal_Data_Available : Boolean := True ) is record 
>     case Internal_Data_Available is
>          when True  =>  Secret_Data : ... ;
>          ...
>   end record;
> 
>   type ... is record 
>     Things_Known : All_We_Konw;
>     ...
>   end record;
>  
> (Ok, stupid example, but you get ist: Data not to be given to an
>  external data processing application can be supressed by the
>  discriminant).

All_We_Know looks much like a handle. Then I'd try to make it more OO, if
you aren't allergic to it. What about tagged types? (:-))

>> and in any case, would use
>> Input for them. 
> 
> I tried to do that, but that didn't fix the problem. I also wouldn't
> expect that: According to Barnes Input most probably uses Read.

Or a part of it. Anyway, try this:

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

procedure 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'Output (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 renames
                  Customer_Description'Input (S);
        begin
           Ada.Text_IO.Put_Line ("Read" & Integer'Image (I));
        end;
     end loop;
     Close (F);
  end;

begin
  Write_Record;
  Get_Record;
end;

It should work with GNAT 3.15p / Windows.

>> 1. You have the discriminant stored anyway (that was the choice about
>> having the defaults), so you cannot use one stored value of the
>> discriminant for all 400 fields, even if they had it same.
> 
> Oops. That I don't understand.

If the discriminant had no default, then Write would not store it. So if
all 400 elements had the same value of the discriminant, you could first
store its value manually (Boolean'Write) and then use 'Write for each
element. When reading you'd read the discriminant value once and then use
Read on a variable constrained to that value:

type Foo (C : Boolean) is ...;

Boolean'Write (S, False);
for I in ... loop
   Foo'Write (S, Get_R (I)); -- I know that all C's are same
end loop;

declare
   C : Boolean;
begin
   Boolean'Read (S, C);
   declare
      R : Foo (C);
   begin
      for I in ... loop
         Foo'Real (S, R); -- I know that all C's are same
      end loop;

>> 2. Read means that you have one extra initialize / finalize pair. Input
>> does not:
> 
> I don't care. Input is slow anyway and doesn't happen so often :-).

So it is safe to use it, at least to work the bug around.

-- 
Regards,
Dmitry A. Kazakov
http://www.dmitry-kazakov.de