paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-05 01:50:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ test for "varargs"

Browse Source 
git-svn-id: trunk@4881 -
This commit is contained in:
Jonas Maebe 2006-10-13 12:35:55 +00:00
parent e9cabd17e1
commit f2ab0e1f92
2 changed files with 171 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -6213,6 +6213,7 @@ tests/test/cg/tobjsize.pp svneol=native#text/plain
tests/test/cg/tpara1.pp svneol=native#text/plain
tests/test/cg/tpara2.pp svneol=native#text/plain
tests/test/cg/tprintf.pp svneol=native#text/plain
tests/test/cg/tprintf2.pp svneol=native#text/plain
tests/test/cg/traise1.pp svneol=native#text/plain
tests/test/cg/traise2.pp svneol=native#text/plain
tests/test/cg/traise3.pp svneol=native#text/plain

170
tests/test/cg/tprintf2.pp Normal file
View File

@ -0,0 +1,170 @@
{ %version=1.1 }
{ %NOTE=This test requires a C library }
{$mode objfpc}
uses
strings;
{$if defined(win32) or defined(wince)}
const
{$ifdef wince}
CrtLib = 'coredll.dll';
{$else}
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');
// 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 FPC_HAS_TYPE_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 FPC_HAS_TYPE_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 FPC_HAS_TYPE_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 FPC_HAS_TYPE_EXTENDED}
if has_errors then
halt(1);
end.