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