paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 19:29:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* very basic C ... args testing

Browse Source
This commit is contained in:
pierre 2002-10-31 16:09:57 +00:00
parent 0f45e9f38f
commit f22c4d2a62
1 changed files with 57 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
tests/test/cg/tprintf.pp Normal file
View File

@ -0,0 +1,57 @@
{ %NOTE=This test requires a C library }
{$mode objfpc}
{$linklib c}
uses
strings;
type
THandle = longint;
const
l : longint = 45;
s : pchar = 'Enclosed text';
d : double = 45.45;
p : pchar = nil;
has_errors : boolean = false;
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;
begin
getmem(p,500);
Writeln('Testing C printf function called from FPC code');
// printf('Simple test without arg'#10,[]);
Writeln('Testing with single pchar argument');
printf('Text containing "%s" text'#10,[s]);
sprintf(p,'Text containing "%s" text'#10,[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'#10,[l]);
sprintf(p,'Text containing longint : %d'#10,[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 double argument');
printf('Text containing double : %f'#10,[d]);
sprintf(p,'Text containing double : %f'#10,[d]);
if strpos(p,' : 45.45')=nil then
begin
writeln('The output of sprintf for double is wrong:',p);
has_errors:=true;
end;
if has_errors then
halt(1);
end.