tprintf.pp 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150
  1. { %version=1.1 }
  2. { %NOTE=This test requires a C library }
  3. {$mode objfpc}
  4. uses
  5. strings;
  6. {$ifdef win32}
  7. {$linklib msvcrt}
  8. procedure printf(const formatstr : pchar; const args : array of const);cdecl; external name 'printf';
  9. procedure sprintf(p : pchar;const formatstr : pchar; const args : array of const);cdecl; external name 'sprintf';
  10. {$else}
  11. {$linklib c}
  12. procedure printf(const formatstr : pchar; const args : array of const);cdecl; external;
  13. procedure sprintf(p : pchar;const formatstr : pchar; const args : array of const);cdecl; external;
  14. {$endif}
  15. type
  16. THandle = longint;
  17. const
  18. l : longint = 45;
  19. ll : int64 = 345;
  20. s : pchar = 'Enclosed text';
  21. s2 : pchar = 'next';
  22. si : single = 32.12;
  23. d : double = 45.45;
  24. e : extended = 74.74;
  25. p : pchar = nil;
  26. has_errors : boolean = false;
  27. begin
  28. getmem(p,500);
  29. Writeln('Testing C printf function called from FPC code');
  30. // printf('Simple test without arg'#10,[]);
  31. Writeln('Testing with single pchar argument');
  32. printf('Text containing "%s" text'#10,[s]);
  33. sprintf(p,'Text containing "%s" text'#10,[s]);
  34. if strpos(p,'g "Enclosed text" ')=nil then
  35. begin
  36. writeln('The output of sprintf for pchar is wrong: ',p);
  37. has_errors:=true;
  38. end;
  39. Writeln('Testing with single longint argument');
  40. printf('Text containing longint: %d'#10,[l]);
  41. sprintf(p,'Text containing longint: %d'#10,[l]);
  42. if strpos(p,'longint: 45')=nil then
  43. begin
  44. writeln('The output of sprintf for longint is wrong: ',p);
  45. has_errors:=true;
  46. end;
  47. Writeln('Testing with single int64 argument');
  48. printf('Text containing int64: %lld'#10,[ll]);
  49. sprintf(p,'Text containing int64: %lld'#10,[ll]);
  50. if strpos(p,'int64: 345')=nil then
  51. begin
  52. writeln('The output of sprintf for int64 is wrong: ',p);
  53. has_errors:=true;
  54. end;
  55. Writeln('Testing with single single argument');
  56. printf('Text containing single: %f'#10,[si]);
  57. sprintf(p,'Text containing single: %f'#10,[si]);
  58. if strpos(p,'single: 32.1')=nil then
  59. begin
  60. writeln('The output of sprintf for double is wrong: ',p);
  61. has_errors:=true;
  62. end;
  63. Writeln('Testing with single double argument');
  64. printf('Text containing double: %f'#10,[d]);
  65. sprintf(p,'Text containing double: %f'#10,[d]);
  66. if strpos(p,'double: 45.4')=nil then
  67. begin
  68. writeln('The output of sprintf for double is wrong: ',p);
  69. has_errors:=true;
  70. end;
  71. printf('Text containing long double: %f'#10,[e]);
  72. sprintf(p,'Text containing long double: %f'#10,[e]);
  73. if strpos(p,'long double: 74.7')=nil then
  74. begin
  75. writeln('The output of sprintf for long double is wrong:',p);
  76. has_errors:=true;
  77. end;
  78. Writeln('Testing with combined pchar argument');
  79. printf('Text containing "%s" and "%s" text'#10,[s,s2]);
  80. sprintf(p,'Text containing "%s" and "%s" text'#10,[s,s2]);
  81. if strpos(p,'g "Enclosed text" and "next"')=nil then
  82. begin
  83. writeln('The output of sprintf for two pchars is wrong: ',p);
  84. has_errors:=true;
  85. end;
  86. Writeln('Testing with single longint argument and pchar');
  87. printf('Text containing longint: %d"%s"'#10,[l,s2]);
  88. sprintf(p,'Text containing longint: %d"%s"'#10,[l,s2]);
  89. if strpos(p,'longint: 45"next"')=nil then
  90. begin
  91. writeln('The output of sprintf for longint is wrong: ',p);
  92. has_errors:=true;
  93. end;
  94. Writeln('Testing with single int64 argument and pchar');
  95. printf('Text containing int64: %lld"%s"'#10,[ll,s2]);
  96. sprintf(p,'Text containing int64: %lld"%s"'#10,[ll,s2]);
  97. if strpos(p,'int64: 345"next"')=nil then
  98. begin
  99. writeln('The output of sprintf for int64 is wrong: ',p);
  100. has_errors:=true;
  101. end;
  102. Writeln('Testing with single single argument');
  103. printf('Text containing single: %f"%s"'#10,[si,s2]);
  104. sprintf(p,'Text containing single: %f"%s"'#10,[si,s2]);
  105. if (strpos(p,'single: 32.1')=nil) or
  106. (strpos(p,'"next"')=nil) then
  107. begin
  108. writeln('The output of sprintf for double is wrong: ',p);
  109. has_errors:=true;
  110. end;
  111. Writeln('Testing with single double argument');
  112. printf('Text containing double: %f"%s"'#10,[d,s2]);
  113. sprintf(p,'Text containing double: %f"%s"'#10,[d,s2]);
  114. if (strpos(p,'double: 45.4')=nil) or
  115. (strpos(p,'"next"')=nil) then
  116. begin
  117. writeln('The output of sprintf for double is wrong: ',p);
  118. has_errors:=true;
  119. end;
  120. printf('Text containing long double: %f"%s"'#10,[e,s2]);
  121. sprintf(p,'Text containing long double: %f"%s"'#10,[e,s2]);
  122. if (strpos(p,'long double: 74.7')=nil) or
  123. (strpos(p,'"next"')=nil) then
  124. begin
  125. writeln('The output of sprintf for long double is wrong:',p);
  126. has_errors:=true;
  127. end;
  128. if has_errors then
  129. halt(1);
  130. end.