freepascal.compiler/tests/webtbs/tw38549.pp

type

{$ifdef SET_39}
  {$define SET_31}
{$endif}
{$ifdef SET_31}
  {$define SET_25}
{$endif}
{$ifdef SET_25}
  {$define SET_23}
{$endif}
{$ifdef SET_23}
  {$define SET_17}
{$endif}
{$ifdef SET_17}
  {$define SET_15}
{$endif}
{$ifdef SET_15}
  {$define SET_9}
{$endif}

  { options for symtables }
  tsymtableoption = (
    sto_has_helper,       { contains at least one helper symbol }
    sto_has_generic,      { contains at least one generic symbol }
    sto_has_operator,     { contains at least one operator overload }
    sto_needs_init_final, { the symtable needs initialization and/or
                            finalization of variables/constants }
    sto_has_non_trivial_init, { contains at least on managed type that is not
                               initialized to zero (e.g. a record with management
                               operators }
    sto_above
{$ifdef SET_9}
    ,sto_6
    ,sto_7
    ,sto_8
    ,sto_9
{$endif}
{$ifdef SET_15}
    ,sto_10
    ,sto_11
    ,sto_12
    ,sto_13
    ,sto_14
    ,sto_15
{$endif}
{$ifdef SET_17}
    ,sto_16
    ,sto_17
{$endif}
{$ifdef SET_23}
    ,sto_18
    ,sto_19
    ,sto_20
    ,sto_21
    ,sto_22
    ,sto_23
{$endif}
{$ifdef SET_25}
    ,sto_24
    ,sto_25
{$endif}
{$ifdef SET_31}
    ,sto_26
    ,sto_27
    ,sto_28
    ,sto_29
    ,sto_30
    ,sto_31
{$endif}
{$ifdef SET_39}
    ,sto_32
    ,sto_33
    ,sto_34
    ,sto_35
    ,sto_36
    ,sto_37
    ,sto_38
    ,sto_39
{$endif}
  );
  tsymtableoptions = set of tsymtableoption;

const
  ok_count : longint = 0;
  error_count : longint = 0;

procedure add_error;
begin
  writeln('New error');
  inc(error_count);
end; 

procedure test(tableoptions : tsymtableoptions; expected : boolean);
begin
 if [sto_needs_init_final,sto_has_non_trivial_init] <= tableoptions then
   begin
     if expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end
 else
   begin
     if not expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end;
 if tableoptions >= [sto_needs_init_final,sto_has_non_trivial_init] then
   begin
     if expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end
 else
   begin
     if not expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end
end;

procedure test2(tableoptions1, tableoptions2 : tsymtableoptions; expected : boolean);
begin
 if tableoptions1 <= tableoptions2 then
   begin
     if expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end
 else
   begin
     if not expected then
       begin
         writeln('Ok');
         inc(ok_count);
       end
     else
       add_error;
   end
end;

var
  tableoptions1, tableoptions2 : tsymtableoptions;

begin
  tableoptions1:=[];
  test(tableoptions1,false);

  tableoptions1:=[sto_has_helper];
  test(tableoptions1,false);

  tableoptions1:=[sto_needs_init_final];
  test(tableoptions1,false);

  tableoptions1:=[sto_has_non_trivial_init];
  test(tableoptions1,false);

  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
  test(tableoptions1,true);

  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
  test(tableoptions1,true);

  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init,sto_above];
  test(tableoptions1,true);

  tableoptions1:=[sto_has_helper,sto_has_non_trivial_init,sto_above];
  test(tableoptions1,false);

  tableoptions1:=[];
  tableoptions2:=[];
  test2(tableoptions1,tableoptions2,true);
  test2(tableoptions2,tableoptions1,true);

  tableoptions2:=[sto_has_helper];
  test2(tableoptions1,tableoptions2,true);
  test2(tableoptions2,tableoptions1,false);

  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_has_helper];
  test2(tableoptions1,tableoptions2,true);
  test2(tableoptions2,tableoptions1,false);
  test2(tableoptions1,tableoptions1,true);
  test2(tableoptions2,tableoptions2,true);

  tableoptions1:=[sto_needs_init_final,sto_has_non_trivial_init];
  tableoptions2:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
  test2(tableoptions1,tableoptions2,true);
  test2(tableoptions2,tableoptions1,false);

  tableoptions1:=[sto_has_helper,sto_needs_init_final,sto_has_non_trivial_init];
  tableoptions2:=[sto_needs_init_final,sto_has_non_trivial_init,sto_above];
  test2(tableoptions1,tableoptions2,false);
  test2(tableoptions2,tableoptions1,false);

  writeln('Test for sets of size : ',sizeof(tableoptions1));
  if error_count > 0 then
    begin
      writeln(error_count,' test(s) failed');
      writeln(ok_count,' test(s) OK');
      halt(1);
    end
  else
    writeln('Test OK: ',ok_count);
end.