1{ %version=1.1 }
2{ %cpu=i386,powerpc,powerpc64,x86_64,arm }
3{ %NOTE=This test requires a C library }
4
5{$mode macpas}
6
7uses
8  strings, uprintf3, ctypes;
9
10{$ifdef FPC_HAS_TYPE_EXTENDED}
11{$define TEST_EXTENDED}
12{$endif FPC_HAS_TYPE_EXTENDED}
13
14{$ifdef beos}
15  {it seems that BeOS doesn't support extended...}
16  {$undef TEST_EXTENDED}
17{$endif beos}
18
19{$ifdef WINDOWS}
20  { the msvcrt.dll doesn't support extended because MS-C doesn't }
21  {$undef TEST_EXTENDED}
22{$endif WINDOWS}
23
24
25const
26{$ifdef macos}
27  lineending = #13;
28{$else}
29  lineending = #10;
30{$endif}
31
32
33type
34 THandle = longint;
35const
36  l : longint = 45;
37  ll : int64 = 345;
38  s : pchar = 'Enclosed text';
39  s2 : pchar = 'next';
40  si : single = 32.12;
41  d : double = 45.45;
42  e : cextended = 74.74;
43  p : pchar = nil;
44  has_errors : boolean = false;
45
46begin
47  getmem(p,500);
48
49  Writeln('Testing C printf function called from FPC code');
50  { for some CPUs, this requires also different calling conventions
51    than procedures taking a single pchar parameter, see #7504 (FK) }
52  printf('Simple test without arg'+lineending);
53
54  Writeln('Testing with single pchar argument');
55  printf('Text containing "%s" text'+lineending,s);
56  sprintf(p,'Text containing "%s" text'+lineending,s);
57  if strpos(p,'g "Enclosed text" ')=nil then
58    begin
59      writeln('The output of sprintf for pchar is wrong: ',p);
60      has_errors:=true;
61    end;
62
63  Writeln('Testing with single longint argument');
64  printf('Text containing longint: %d'+lineending,l);
65  sprintf(p,'Text containing longint: %d'+lineending,l);
66  if strpos(p,'longint: 45')=nil then
67    begin
68      writeln('The output of sprintf for longint is wrong: ',p);
69      has_errors:=true;
70    end;
71
72  Writeln('Testing with single int64 argument');
73  printf('Text containing int64: %'+int64prefix+'d'+lineending,ll);
74  sprintf(p,'Text containing int64: %'+int64prefix+'d'+lineending,ll);
75  if strpos(p,'int64: 345')=nil then
76    begin
77      writeln('The output of sprintf for int64 is wrong: ',p);
78      has_errors:=true;
79    end;
80
81  Writeln('Testing with single single argument');
82  printf('Text containing single: %f'+lineending,si);
83  sprintf(p,'Text containing single: %f'+lineending,si);
84  if strpos(p,'single: 32.1')=nil then
85    begin
86      writeln('The output of sprintf for double is wrong: ',p);
87      has_errors:=true;
88    end;
89
90  Writeln('Testing with single double argument');
91  printf('Text containing double: %lf'+lineending,d);
92  sprintf(p,'Text containing double: %lf'+lineending,d);
93  if strpos(p,'double: 45.4')=nil then
94    begin
95      writeln('The output of sprintf for double is wrong: ',p);
96      has_errors:=true;
97    end;
98
99{$ifdef TEST_EXTENDED}
100  printf('Text containing long double: %Lf'+lineending,e);
101  sprintf(p,'Text containing long double: %Lf'+lineending,e);
102  if strpos(p,'long double: 74.7')=nil then
103    begin
104      writeln('The output of sprintf for long double is wrong:',p);
105      has_errors:=true;
106    end;
107{$endif TEST_EXTENDED}
108
109  Writeln('Testing with combined pchar argument');
110  printf('Text containing "%s" and "%s" text'+lineending,s,s2);
111  sprintf(p,'Text containing "%s" and "%s" text'+lineending,s,s2);
112  if strpos(p,'g "Enclosed text" and "next"')=nil then
113    begin
114      writeln('The output of sprintf for two pchars is wrong: ',p);
115      has_errors:=true;
116    end;
117
118  Writeln('Testing with single longint argument and pchar');
119  printf('Text containing longint: %d"%s"'+lineending,l,s2);
120  sprintf(p,'Text containing longint: %d"%s"'+lineending,l,s2);
121  if strpos(p,'longint: 45"next"')=nil then
122    begin
123      writeln('The output of sprintf for longint is wrong: ',p);
124      has_errors:=true;
125    end;
126
127  Writeln('Testing with single int64 argument and pchar');
128  printf('Text containing int64: %'+int64prefix+'d"%s"'+lineending,ll,s2);
129  sprintf(p,'Text containing int64: %'+int64prefix+'d"%s"'+lineending,ll,s2);
130  if strpos(p,'int64: 345"next"')=nil then
131    begin
132      writeln('The output of sprintf for int64 is wrong: ',p);
133      has_errors:=true;
134    end;
135
136  Writeln('Testing with single single argument');
137  printf('Text containing single: %f"%s"'+lineending,si,s2);
138  sprintf(p,'Text containing single: %f"%s"'+lineending,si,s2);
139  if (strpos(p,'single: 32.1')=nil) or
140     (strpos(p,'"next"')=nil) then
141    begin
142      writeln('The output of sprintf for double is wrong: ',p);
143      has_errors:=true;
144    end;
145
146  Writeln('Testing with single double argument');
147  printf('Text containing double: %lf"%s"'+lineending,d,s2);
148  sprintf(p,'Text containing double: %lf"%s"'+lineending,d,s2);
149  if (strpos(p,'double: 45.4')=nil) or
150     (strpos(p,'"next"')=nil) then
151    begin
152      writeln('The output of sprintf for double is wrong: ',p);
153      has_errors:=true;
154    end;
155
156{$ifdef TEST_EXTENDED}
157  printf('Text containing long double: %Lf"%s"'+lineending,e,s2);
158  sprintf(p,'Text containing long double: %Lf"%s"'+lineending,e,s2);
159  if (strpos(p,'long double: 74.7')=nil) or
160     (strpos(p,'"next"')=nil) then
161    begin
162      writeln('The output of sprintf for long double is wrong:',p);
163      has_errors:=true;
164    end;
165{$endif TEST_EXTENDED}
166
167  if has_errors then
168    halt(1);
169end.
170