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

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

{$mode objfpc}

uses
  strings;

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

{$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); varargs; cdecl; external CrtLib name 'printf';
procedure sprintf(p : pchar;const formatstr : pchar); varargs; cdecl; external CrtLib name 'sprintf';
const
  int64prefix='I64';
{$else}
{$linklib c}
procedure printf(const formatstr : pchar); varargs; cdecl; external;
procedure sprintf(p : pchar;const formatstr : pchar); varargs; 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 : extended = 74.74;
  p : pchar = nil;
  has_errors : boolean = false;

begin
  getmem(p,500);

  Writeln('Testing C printf function called from FPC code');
  { for some CPUs, this requires also different calling conventions
    than procedures taking a single pchar parameter, see #7504 (FK) }
  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.