+ test for macpas interface units, mwpascal and varargs

git-svn-id: trunk@4911 -

.gitattributes

@@ -6213,6 +6213,7 @@ 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/tprintf3.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
@@ -6229,6 +6230,7 @@ tests/test/cg/ttryfin2.pp svneol=native#text/plain
 tests/test/cg/ttryfin3.pp svneol=native#text/plain
 tests/test/cg/ttryfin4.pp svneol=native#text/plain
 tests/test/cg/tvec.pp svneol=native#text/plain
+tests/test/cg/uprintf3.pp svneol=native#text/plain
 tests/test/dumpclass.pp svneol=native#text/plain
 tests/test/dumpmethods.pp svneol=native#text/plain
 tests/test/opt/README -text

tests/test/cg/tprintf3.pp

@@ -0,0 +1,154 @@
+{ %version=1.1 }
+{ %cpu=i386,powerpc }
+{ %NOTE=This test requires a C library }
+
+{$mode macpas}
+
+uses
+  strings, uprintf3;
+
+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');
+  { for some CPUs, this requires also different calling conventions
+    than procedures taking a single pchar parameter, see #7504 (FK) }
+  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.

tests/test/cg/uprintf3.pp

@@ -0,0 +1,35 @@
+unit uprintf3;
+
+{$mode macpas}
+
+interface
+
+{$calling mwpascal}
+
+{$if defined(win32) or defined(wince)}
+const
+{$ifdef wince}
+  CrtLib = 'coredll.dll';
+{$else}
+  CrtLib = 'msvcrt.dll';
+{$endif}
+
+procedure printf(const formatstr : pchar; ...); external CrtLib name 'printf';
+procedure sprintf(p : pchar;const formatstr : pchar; ...); external CrtLib name 'printf';
+const
+  int64prefix='I64';
+{$else}
+{$linklib c}
+{$ifndef darwin}
+procedure printf(const formatstr : pchar; ...); external;
+procedure sprintf(p : pchar;const formatstr : pchar; ...); external;
+{$else darwin}
+procedure printf(const formatstr : pchar; ...); external name '_printf';
+procedure sprintf(p : pchar;const formatstr : pchar; ...); external name '_sprintf';
+{$endif darwin}
+const
+  int64prefix='ll';
+{$endif}
+
+
+end.