freepascal.compiler/tests/test/cg/tldparam.pp

{ This tests the passing of parameters of routines }
{ and how they are accessed.                       }
{ Tests secondload() and secondcallparan()         }

{ TO DO :                                         }
{   Add testing for complex parameters            }
{   such as string, arrays and sets               }


{ ***************************************************************** }
{                         SIMPLE TYPES                              }
{ ***************************************************************** }

  procedure testvaluebyte(b: byte);
   begin
     WriteLn(b);
   end;


  procedure testvalueword(w: word);
   begin
     WriteLn(w);
   end;


  procedure testvaluelong(l : longint);
   begin
     WriteLn(l);
   end;


  procedure testvarbyte(var b: byte);
    begin
      WriteLn(b);
    end;


  procedure testvarword(var w: word);
    begin
      writeln(w);
    end;


  procedure testvarlong(var l : longint);
    begin
      writeln(l);
    end;


  procedure testvaluemixedbyte(b: byte; w: word; l: longint);
    begin
      Writeln(b);
      writeln(w);
      writeln(l);
    end;


  procedure testvaluemixedlong(l : longint; w: word; b: byte);
    begin
      Writeln(l);
      writeln(w);
      writeln(b);
    end;


  procedure testvaluemixedbytebyte(b1: byte; b2: byte; b3: byte);
    begin
      Writeln(b1);
      writeln(b2);
      writeln(b3);
    end;

{$ifdef fpc}
  procedure testvalueint64(i : int64);
    begin
      WriteLn(i);
    end;

  procedure testvarint64(var i : int64);
   begin
     WriteLn(i);
   end;

  procedure testvaluemixedint64(b1: byte; i: int64; b2: byte);
   begin
     WriteLn(b1);
     WriteLn(i);
     WriteLn(b2);
   end;
{$endif}

   procedure testvaluereal(r: real);
    begin
      WriteLn(r);
    end;

   procedure testvaluesingle(s: single);
    begin
      WriteLn(s);
    end;

   procedure testvaluedouble(d: double);
     begin
       WriteLn(d);
     end;


   procedure testvaluemixedreal(b1: byte; r: real; b2: byte);
    begin
      WriteLn(b1);
      WriteLn(r);
      WriteLn(b2);
    end;

  procedure testvarreal(var r: real);
   begin
     WriteLn(r);
   end;

   { only check assembler code }
   { cannot be called directly }
   { because will crash system }
   procedure testint; interrupt;
    begin
    end;



{ ***************************************************************** }
{                        COMPLEX TYPES                              }
{ ***************************************************************** }



{ ***************************************************************** }
{                        RETURN TYPES                               }
{ ***************************************************************** }


   function testretbyte: byte;
     begin
       Write('(byte) : Value should be 127...');
       testretbyte:= 127;
     end;

   function testretword: word;
     begin
       Write('(word) : Value should be 43690...');
       testretword := 43690;
     end;

   function testretlong : longint;
     begin
       Write('(long) : Value should be -1...');
       testretlong := -1;
     end;

   function testretstring: string;
     begin
       Write('(string) : Value should be ''HELLO WORLD''...');
       testretstring := 'HELLO WORLD';
     end;

    function testretreal : real;
      begin
        Write('(real) : Value should be 12.12...');
        testretreal := 12.12;
      end;

    function testretsingle : single;
      begin
        Write('(single) : Value should be 13.13...');
        testretsingle := 13.13;
      end;

    function testretdouble : double;
      begin
        Write('(double) : Value should be 14.14...');
        testretdouble := 14.14;
      end;

    function testretpchar: pchar;
    begin
       Write('(pchar) : Value should be  ...');
       testretpchar := nil;
    end;

{$ifdef fpc}
    function testretint64 : int64;
      begin
        Write('(int64) : Value should be -127...');
        testretint64 := -127;
      end;

    function testretansi: ansistring;
      begin
         Write('(ansi) : Value should be ''HELLO WORLD''...');
         testretansi := 'HELLO WORLD';
      end;


{$ifdef fpc}

{$inline on}

   function testretbyteinline: byte; inline;
     begin
       Write('(byte) : Value should be 126...');
       testretbyteinline:= 126;
     end;

   function testretwordinline: word; inline;
     begin
       Write('(word) : Value should be 43689...');
       testretwordinline := 43689;
     end;

    function testretint64inline : int64;inline;
      begin
        Write('(int64) : Value should be -128...');
        testretint64inline := -128;
      end;

    function testretrealinline : real; inline;
      begin
        Write('(real) : Value should be 110.110...');
        testretrealinline := 110.110;
      end;

    function testretdoubleinline : double; inline;
      begin
        Write('(double) : Value should be 130.130...');
        testretdoubleinline := 130.130;
      end;


   function testretbyteregs: byte; saveregisters;
     begin
       Write('(byte) : Value should be 125...');
       testretbyteregs:= 125;
     end;

   function testretwordregs: word; saveregisters;
     begin
       Write('(word) : Value should be 43688...');
       testretwordregs := 43688;
     end;

    function testretint64regs : int64;saveregisters;
      begin
        Write('(int64) : Value should be -130...');
        testretint64regs := -130;
      end;

    function testretrealregs : real; saveregisters;
      begin
        Write('(real) : Value should be -55.55...');
        testretrealregs := -55.55;
      end;

    function testretdoubleregs : double; saveregisters;
      begin
        Write('(double) : Value should be -77.14...');
        testretdoubleregs := -77.14;
      end;

   function testretbytecdecl: byte; cdecl;
     begin
       Write('(byte) : Value should be 125...');
       testretbytecdecl:= 125;
     end;

   function testretwordcdecl: word; cdecl;
     begin
       Write('(word) : Value should be 43688...');
       testretwordcdecl := 43688;
     end;

    function testretint64cdecl : int64; cdecl;
      begin
        Write('(int64) : Value should be -130...');
        testretint64cdecl := -130;
      end;

    function testretrealcdecl : real; cdecl;
      begin
        Write('(real) : Value should be -55.55...');
        testretrealcdecl := -55.55;
      end;

    function testretdoublecdecl : double; cdecl;
      begin
        Write('(double) : Value should be -77.14...');
        testretdoublecdecl := -77.14;
      end;

{$endif}


{$endif}

var
 b: byte;
 w: word;
 l: longint;
 r: real;
{$ifdef fpc}
  i: int64;
{$endif}
begin
  WriteLn('------------------------------------------------------');
  WriteLN('           TESTING NON-COMPLEX PARAMETERS             ');
  WriteLn('------------------------------------------------------');
{  testint;}
  { check value parameters }
  Write('(byte value param) : Value should be 85...');
  testvaluebyte($55);
  Write('(word value param) : Value should be 43690...');
  testvalueword($AAAA);
  Write('(long value param) : Value should be -1...');
  testvaluelong(-1);
  { check variable parameters }
  b:=$55;
  w:=$AAAA;
  l:=-1;
  Write('(byte var param) : Value should be 85...');
  testvarbyte(b);
  Write('(word var param) : Value should be 43690...');
  testvarword(w);
  Write('(long var param) : Value should be -1...');
  testvarlong(l);
{$ifdef fpc}
  Write('(int64 value param) : Value should be 43690...');
  testvalueint64($AAAA);
  Write('(int64 var param) : Value should be appx. 187 00000000000...');
  i:= $AAAA;
  i:= i shl 32;
  testvarint64(i);
{$endif}
  writeln('(mixed value params) : Values should 85,43690,-1...');
  testvaluemixedbyte($55,$AAAA,-1);
  writeln('(mixed value params) : Values should be -1, 43690, 85...');
  testvaluemixedlong(-1,$AAAA,$55);
  writeln('(mixed value params): Values should be 0, 127, 254...');
  testvaluemixedbytebyte(0,127,254);
{$ifdef fpc}
  writeln('(mixed value params) : Value should be 0, -1, 254...');
  testvaluemixedint64(0,-1,254);
{$endif}
  write('(real value param) : Value should be 1.1...');
  testvaluereal(1.1);
  write('(single value param) : Value should be 2.2...');
  testvaluesingle(2.2);
  write('(double value param) : Value should be 3.3...');
  testvaluedouble(3.3);
  write('(real var param) : Value should be 7.7...');
  r:=7.7;
  testvarreal(r);
  writeln('(mixed value params) : Values should be 0, 10.7, 254...');
  testvaluemixedreal(0,10.7,254);

  WriteLn('------------------------------------------------------');
  WriteLN('              TESTING FUNCTION RESULTS                ');
  WriteLn('------------------------------------------------------');
  WriteLn('----------------------- NORMAL -----------------------');
  WriteLn(testretbyte);
  WriteLn(testretword);
  WriteLn(testretlong);
  WriteLn(testretstring);
  WriteLn(testretreal);
  WriteLn(testretsingle);
  WriteLn(testretdouble);
  WriteLn(testretpchar);
{$ifdef fpc}
  WriteLn(testretint64);
  WriteLn(testretansi);
  WriteLn('----------------------- INLINE -----------------------');
  WriteLn(testretbyteinline);
  WriteLn(testretwordinline);
  WriteLn(testretint64inline);
  WriteLn(testretrealinline);
  WriteLn(testretdoubleinline);
  WriteLn('---------------------- SAVEREGS ----------------------');
  WriteLn(testretbyteregs);
  WriteLn(testretwordregs);
  WriteLn(testretint64regs);
  WriteLn(testretrealregs);
  WriteLn(testretdoubleregs);
  WriteLn('------------------------ CDECL -----------------------');
  WriteLn(testretbytecdecl);
  WriteLn(testretwordcdecl);
  WriteLn(testretint64cdecl);
  WriteLn(testretrealcdecl);
  WriteLn(testretdoublecdecl);
{$endif}
end.

{
  $Log$
  Revision 1.3  2002-09-07 15:40:56  peter
    * old logs removed and tabs fixed

}