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

{ %version=1.1 }
{ %NOTE=This test requires a C library }

{$mode objfpc}

uses
  strings, ctypes;

{$ifdef FPC_HAS_TYPE_EXTENDED}
{$define TEST_EXTENDED}
{$endif FPC_HAS_TYPE_EXTENDED}

{$ifdef beos}
  {it seems that BeOS doesn't support extended...}
  {$undef TEST_EXTENDED}
{$endif beos}

{$if defined(cpux86_64) and defined(android) and (sizeof(clongdouble)<>16)}
  // On x86_64-android long double is 128-bit. There is no support for 128-bit floats in FPC yet.
  {$undef TEST_EXTENDED}
{$endif}

{$ifdef WINDOWS}
const
{$ifdef wince}
  CrtLib = 'coredll.dll';
{$else}
  { the msvcrt.dll doesn't support extended because MS-C doesn't }
  {$undef TEST_EXTENDED}
  CrtLib = 'msvcrt.dll';
{$endif}

procedure printf(const formatstr : pchar; const args : array of const);cdecl; external CrtLib name 'printf';
procedure sprintf(p : pchar;const formatstr : pchar; const args : array of const);cdecl; external CrtLib name 'sprintf';
const
  int64prefix='I64';
{$else}
{$linklib c}
procedure printf(const formatstr : pchar; const args : array of const);cdecl; external;
procedure sprintf(p : pchar;const formatstr : pchar; const args : array of const);cdecl; external;
const
  int64prefix='ll';
{$endif}

const
{$ifdef macos}
  lineending = #13;
{$else}
  lineending = #10;
{$endif}


type
 THandle = longint;
const
  l : longint = 45;
  ll : int64 = 345;
  s : pchar = 'Enclosed text';
  s2 : pchar = 'next';
  si : single = 32.12;
  d : double = 45.45;
  e : cextended = 74.74;
  p : pchar = nil;
  has_errors : boolean = false;

begin
  getmem(p,500);

  Writeln('Testing C printf function called from FPC code');
//  printf('Simple test without arg'+lineending,[]);
  Writeln('Testing with single pchar argument');
  printf('Text containing "%s" text'+lineending,[s]);
  sprintf(p,'Text containing "%s" text'+lineending,[s]);
  if strpos(p,'g "Enclosed text" ')=nil then
    begin
      writeln('The output of sprintf for pchar is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single longint argument');
  printf('Text containing longint: %d'+lineending,[l]);
  sprintf(p,'Text containing longint: %d'+lineending,[l]);
  if strpos(p,'longint: 45')=nil then
    begin
      writeln('The output of sprintf for longint is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single int64 argument');
  printf('Text containing int64: %'+int64prefix+'d'+lineending,[ll]);
  sprintf(p,'Text containing int64: %'+int64prefix+'d'+lineending,[ll]);
  if strpos(p,'int64: 345')=nil then
    begin
      writeln('The output of sprintf for int64 is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single single argument');
  printf('Text containing single: %f'+lineending,[si]);
  sprintf(p,'Text containing single: %f'+lineending,[si]);
  if strpos(p,'single: 32.1')=nil then
    begin
      writeln('The output of sprintf for double is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single double argument');
  printf('Text containing double: %lf'+lineending,[d]);
  sprintf(p,'Text containing double: %lf'+lineending,[d]);
  if strpos(p,'double: 45.4')=nil then
    begin
      writeln('The output of sprintf for double is wrong: ',p);
      has_errors:=true;
    end;

{$ifdef TEST_EXTENDED}
  printf('Text containing long double: %Lf'+lineending,[e]);
  sprintf(p,'Text containing long double: %Lf'+lineending,[e]);
  if strpos(p,'long double: 74.7')=nil then
    begin
      writeln('The output of sprintf for long double is wrong:',p);
      has_errors:=true;
    end;
{$endif TEST_EXTENDED}

  Writeln('Testing with combined pchar argument');
  printf('Text containing "%s" and "%s" text'+lineending,[s,s2]);
  sprintf(p,'Text containing "%s" and "%s" text'+lineending,[s,s2]);
  if strpos(p,'g "Enclosed text" and "next"')=nil then
    begin
      writeln('The output of sprintf for two pchars is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single longint argument and pchar');
  printf('Text containing longint: %d"%s"'+lineending,[l,s2]);
  sprintf(p,'Text containing longint: %d"%s"'+lineending,[l,s2]);
  if strpos(p,'longint: 45"next"')=nil then
    begin
      writeln('The output of sprintf for longint is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single int64 argument and pchar');
  printf('Text containing int64: %'+int64prefix+'d"%s"'+lineending,[ll,s2]);
  sprintf(p,'Text containing int64: %'+int64prefix+'d"%s"'+lineending,[ll,s2]);
  if strpos(p,'int64: 345"next"')=nil then
    begin
      writeln('The output of sprintf for int64 is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single single argument');
  printf('Text containing single: %f"%s"'+lineending,[si,s2]);
  sprintf(p,'Text containing single: %f"%s"'+lineending,[si,s2]);
  if (strpos(p,'single: 32.1')=nil) or
     (strpos(p,'"next"')=nil) then
    begin
      writeln('The output of sprintf for double is wrong: ',p);
      has_errors:=true;
    end;

  Writeln('Testing with single double argument');
  printf('Text containing double: %lf"%s"'+lineending,[d,s2]);
  sprintf(p,'Text containing double: %lf"%s"'+lineending,[d,s2]);
  if (strpos(p,'double: 45.4')=nil) or
     (strpos(p,'"next"')=nil) then
    begin
      writeln('The output of sprintf for double is wrong: ',p);
      has_errors:=true;
    end;

{$ifdef TEST_EXTENDED}
  printf('Text containing long double: %Lf"%s"'+lineending,[e,s2]);
  sprintf(p,'Text containing long double: %Lf"%s"'+lineending,[e,s2]);
  if (strpos(p,'long double: 74.7')=nil) or
     (strpos(p,'"next"')=nil) then
    begin
      writeln('The output of sprintf for long double is wrong:',p);
      has_errors:=true;
    end;
{$endif TEST_EXTENDED}

  if has_errors then
    halt(1);
end.