Browse Source

* several new test for cdecl in new subdirectory

pierre 23 years ago
parent
commit
2489b9630b

+ 31 - 0
tests/test/cg/cdecl/taoc1.pp

@@ -0,0 +1,31 @@
+
+{ first simple array of const test }
+
+{$mode objfpc}
+
+
+program test_cdecl_array_of_const;
+
+var
+ l : longint;
+
+const
+  has_errors : boolean = false;
+
+procedure test(var ll : longint;format : pchar; const args : array of const);cdecl;
+begin
+ ll:=5;
+end;
+
+begin
+ l:=4;
+ test(l,'dummy',[]);
+ if l<>5 then
+   has_errors:=true;
+ l:=4;
+ test(l,'dummy',[345]);
+ if l<>5 then
+   has_errors:=true;
+ if has_errors then
+   halt(1);
+end.

+ 33 - 0
tests/test/cg/cdecl/taoc2.pp

@@ -0,0 +1,33 @@
+{ %FAIL }
+{ second simple array of const test }
+{ there is no way to know the address of anything
+  as the array of const is pushed directly }
+
+{$mode objfpc}
+
+
+program test_cdecl_array_of_const;
+
+var
+ l : longint;
+
+const
+  has_errors : boolean = false;
+
+procedure test(format : pchar; const args : array of const; var ll : longint);cdecl;
+begin
+ ll:=5;
+end;
+
+begin
+ l:=4;
+ test('dummy',[],l);
+ if l<>5 then
+   has_errors:=true;
+ l:=4;
+ test('dummy',[345],l);
+ if l<>5 then
+   has_errors:=true;
+ if has_errors then
+   halt(1);
+end.

+ 30 - 0
tests/test/cg/cdecl/taoc3.pp

@@ -0,0 +1,30 @@
+{ %FAIL }
+{ second simple array of const test }
+{ there is no way know how many args
+  are psuhed for a cdecl'ared araay of const
+  the compiler should complain here }
+
+{$mode objfpc}
+
+
+program test_cdecl_array_of_const;
+
+var
+ l : longint;
+
+const
+  has_errors : boolean = false;
+
+procedure test(format : pchar; const args : array of const);cdecl;
+begin
+ l:=high(args);
+end;
+
+begin
+ l:=4;
+ test('dummy',[234]);
+ if l<>1 then
+   has_errors:=true;
+ if has_errors then
+   halt(1);
+end.

+ 54 - 0
tests/test/cg/cdecl/taoc4.pp

@@ -0,0 +1,54 @@
+
+{ fourth simple array of const test }
+
+{$mode objfpc}
+
+
+program test_cdecl_array_of_const;
+
+var
+ l : longint;
+
+const
+  has_errors : boolean = false;
+
+procedure test_one_longint(args : array of const);cdecl;
+var
+  p : plongint;
+begin
+ p:=plongint(@args);
+ l:=p^;
+end;
+
+procedure test_two_longints(args : array of const);cdecl;
+var
+  p : plongint;
+begin
+ p:=plongint(@args);
+ cardinal(p):=cardinal(p)+sizeof(longint);
+ l:=p^;
+end;
+
+begin
+ l:=4;
+ test_one_longint([345]);
+ if l<>345 then
+   has_errors:=true;
+ l:=4;
+ test_one_longint([345,245]);
+ if l<>345 then
+   has_errors:=true;
+ l:=4;
+ test_one_longint([345,245,678]);
+ if l<>345 then
+   has_errors:=true;
+ l:=4;
+ test_two_longints([345,456]);
+ if l<>456 then
+   has_errors:=true;
+ if has_errors then
+   begin
+     Writeln('cdecl array of const problem');
+     halt(1);
+   end;
+end.

+ 56 - 0
tests/test/cg/cdecl/taoc5.pp

@@ -0,0 +1,56 @@
+
+{ fifth simple array of const test }
+
+{$mode objfpc}
+
+
+program test_cdecl_array_of_const;
+
+var
+ l : double;
+
+const
+  has_errors : boolean = false;
+
+procedure test_one_double(args : array of const);cdecl;
+type
+  pdouble = ^double;
+var
+  p : pdouble;
+begin
+ p:=pdouble(@args);
+ l:=p^;
+end;
+
+procedure test_two_doubles(args : array of const);cdecl;
+var
+  p : pdouble;
+begin
+ p:=pdouble(@args);
+ cardinal(p):=cardinal(p)+sizeof(double);
+ l:=p^;
+end;
+
+begin
+ l:=4.0;
+ test_one_double([3.45]);
+ if abs(l-3.45)>0.01 then
+   has_errors:=true;
+ l:=4.0;
+ test_one_double([3.45,2.45]);
+ if abs(l-3.45)>0.01 then
+   has_errors:=true;
+ l:=4;
+ test_one_double([3.45,24.25,678.8]);
+ if abs(l-3.45)>0.01 then
+   has_errors:=true;
+ l:=4;
+ test_two_doubles([3.45,4.56]);
+ if abs(l-4.56)>0.01 then
+   has_errors:=true;
+ if has_errors then
+   begin
+     Writeln('cdecl array of const problem');
+     halt(1);
+   end;
+end.

+ 64 - 0
tests/test/cg/cdecl/taoc6.pp

@@ -0,0 +1,64 @@
+
+{ sixth simple array of const test
+  for int64 values }
+
+{$mode objfpc}
+
+program test_cdecl_array_of_const;
+
+type
+  pint64 = ^int64;
+var
+  l : int64;
+
+
+
+const
+  has_errors : boolean = false;
+
+procedure test_one_int64(args : array of const);cdecl;
+var
+  p : pint64;
+begin
+ p:=pint64(@args);
+ l:=p^;
+end;
+
+procedure test_two_int64(args : array of const);cdecl;
+var
+  p : pint64;
+begin
+ p:=pint64(@args);
+ cardinal(p):=cardinal(p)+sizeof(int64);
+ l:=p^;
+end;
+
+
+var
+ i,j : int64;
+
+begin
+ i:=$65ffffff;
+ i:=i*5698;
+ j:=2*i;
+ test_one_int64([i]);
+ if l<>i then
+   has_errors:=true;
+ l:=4;
+ test_one_int64([j,i]);
+ if l<>j then
+   has_errors:=true;
+ l:=4;
+ test_one_int64([i+j,i,j]);
+ if l<>i+j then
+   has_errors:=true;
+ l:=4;
+ test_two_int64([i+j,j-i]);
+ if l<>j-i then
+   has_errors:=true;
+ if has_errors then
+   begin
+     Writeln('cdecl array of const problem for int64');
+     halt(1);
+   end;
+end.