+ a bunch of jvm-specific tests: partly new, partly derived from existing

    tests
   o currently not yet integrated in the makefile system, use testall.sh/
     testall.bat to run the tests

git-svn-id: branches/jvmbackend@18777 -

.gitattributes

@@ -9757,6 +9757,56 @@ tests/test/cg/variants/tvarol94.pp svneol=native#text/plain
 tests/test/cg/variants/tvarol96.pp svneol=native#text/plain
 tests/test/dumpclass.pp svneol=native#text/plain
 tests/test/dumpmethods.pp svneol=native#text/plain
+tests/test/jvm/JavaClass.java svneol=native#text/plain
+tests/test/jvm/classlist.pp svneol=native#text/plain
+tests/test/jvm/classmeth.pp svneol=native#text/plain
+tests/test/jvm/forw.pp svneol=native#text/plain
+tests/test/jvm/getbit.pp svneol=native#text/plain
+tests/test/jvm/nested.pp svneol=native#text/plain
+tests/test/jvm/outpara.pp svneol=native#text/plain
+tests/test/jvm/sort.pp svneol=native#text/plain
+tests/test/jvm/tabs.pp svneol=native#text/plain
+tests/test/jvm/taddset.pp svneol=native#text/plain
+tests/test/jvm/taddsetint.pp svneol=native#text/plain
+tests/test/jvm/tarray2.pp svneol=native#text/plain
+tests/test/jvm/tarray3.pp svneol=native#text/plain
+tests/test/jvm/tbyte.pp svneol=native#text/plain
+tests/test/jvm/tbytearrres.pp svneol=native#text/plain
+tests/test/jvm/tclassproptest.pp svneol=native#text/plain
+tests/test/jvm/tcnvstr1.pp svneol=native#text/plain
+tests/test/jvm/tcnvstr3.pp svneol=native#text/plain
+tests/test/jvm/tconst.pp svneol=native#text/plain
+tests/test/jvm/tdefpara.pp svneol=native#text/plain
+tests/test/jvm/tdynarrec.pp svneol=native#text/plain
+tests/test/jvm/tenum.pp svneol=native#text/plain
+tests/test/jvm/test.pp -text svneol=native#text/plain
+tests/test/jvm/testall.bat -text svneol=native#application/x-bat
+tests/test/jvm/testall.sh -text svneol=native#application/x-sh
+tests/test/jvm/testansi.pp svneol=native#text/plain
+tests/test/jvm/testintf.pp svneol=native#text/plain
+tests/test/jvm/testshort.pp svneol=native#text/plain
+tests/test/jvm/tformalpara.pp svneol=native#text/plain
+tests/test/jvm/tint.pp svneol=native#text/plain
+tests/test/jvm/tintstr.pp svneol=native#text/plain
+tests/test/jvm/tnestproc.pp svneol=native#text/plain
+tests/test/jvm/tprop.pp svneol=native#text/plain
+tests/test/jvm/tprop2.pp svneol=native#text/plain
+tests/test/jvm/tpvar.pp svneol=native#text/plain
+tests/test/jvm/tpvardelphi.pp svneol=native#text/plain
+tests/test/jvm/tpvarglobal.pp svneol=native#text/plain
+tests/test/jvm/tpvarglobaldelphi.pp svneol=native#text/plain
+tests/test/jvm/trange1.pp svneol=native#text/plain
+tests/test/jvm/trange2.pp svneol=native#text/plain
+tests/test/jvm/trange3.pp svneol=native#text/plain
+tests/test/jvm/tset1.pp svneol=native#text/plain
+tests/test/jvm/tset3.pp svneol=native#text/plain
+tests/test/jvm/ttrig.pp svneol=native#text/plain
+tests/test/jvm/ttrunc.pp svneol=native#text/plain
+tests/test/jvm/tvarpara.pp svneol=native#text/plain
+tests/test/jvm/tvirtclmeth.pp svneol=native#text/plain
+tests/test/jvm/twith.pp svneol=native#text/plain
+tests/test/jvm/uenum.pp svneol=native#text/plain
+tests/test/jvm/unsupported.pp svneol=native#text/plain
 tests/test/lcpref.inc svneol=native#text/plain
 tests/test/library/testdll.pp svneol=native#text/plain
 tests/test/library/testdll2.pp svneol=native#text/plain

tests/test/jvm/JavaClass.java

@@ -0,0 +1,260 @@
+import org.freepascal.rtl.*;
+import org.freepascal.test.*;
+
+
+public class JavaClass
+{
+
+public static void main(String[] args) throws java.lang.Exception
+{
+  TMyClass t = new TMyClass();
+
+  tintfclass intfclass;
+  tintfclass2 intfclass2;
+  tinterface1 intf1;
+  tinterface3 intf3;
+  tinterface4 intf4;
+  Object obj = new trec();
+  System.out.println(((trec)obj).a);
+ 
+  // check referencing a nested class
+  tisclass1.tisclass1nested nestedclass = new tisclass1.tisclass1nested();
+  
+
+  System.out.println("t.test(10,8) should return 3: "+t.test(10,8));
+  System.out.println("t.test(20,1) should return -1: "+t.test(20,1));
+  t.setintfield(123);
+  System.out.println("t.getintfield should return 123: "+t.getintfield());
+  t.setstaticbytefield((byte)42);
+  System.out.println("t.getstaticbytefield should return 42: "+t.getstaticbytefield());
+  System.out.println("myrec.a should return 42: "+test.myrec.a);
+  System.out.println("myrec.b should return 1234: "+test.myrec.b);
+  System.out.println("TMyClass.rec.c should return 5678: "+TMyClass.rec.c);
+  System.out.println("test.tcl should return 4: "+test.tcl);
+  System.out.println("test.tcrec.a should return 1: "+test.tcrec.a);
+  System.out.println("test.tcrec.e should return 5: "+test.tcrec.e);
+  System.out.println("test.tcnestrec.r.d should return 4: "+test.tcnestrec.r.d);
+  System.out.println("test.tcnestrec.r.arr[1] should return 6: "+test.tcnestrec.arr[1]);
+  TMyClass.settestglobal(654321);
+  System.out.println("TMyClass.gettestglobal should return 654321: "+TMyClass.gettestglobal());
+  System.out.println("TMyClass.staticmul3(3) should return 9: "+TMyClass.staticmul3(3));
+  System.out.println("testset should return 0: "+test.testset());
+  System.out.println("testloop should return 0: "+test.testloop());
+  System.out.println("testfloat should return 0: "+test.testfloat());
+  System.out.println("testint2real should return 0: "+test.testint2real());
+  System.out.println("testcnvint1 should return 0: "+test.testcnvint1());
+  System.out.println("TestCmpListOneShort should return 0: "+test.TestCmpListOneShort());
+  System.out.println("TestCmpListTwoShort should return 0: "+test.TestCmpListTwoShort());
+  System.out.println("TestCmpListOneWord should return 0: "+test.TestCmpListOneWord());
+  System.out.println("TestCmpListTwoWord should return 0: "+test.TestCmpListTwoWord());
+  System.out.println("TestCmpListRangesOneShort should return 0: "+test.TestCmpListRangesOneShort());
+  System.out.println("TestCmpListRangesTwoShort should return 0: "+test.TestCmpListRangesTwoShort());
+  System.out.println("TestCmpListRangesOneWord should return 0: "+test.TestCmpListRangesOneWord());
+  System.out.println("TestCmpListRangesTwoWord should return 0: "+test.TestCmpListRangesTwoWord());
+  System.out.println("TestCmpListRangesThreeWord should return 0: "+test.TestCmpListRangesThreeWord());
+  System.out.println("TestCmpListOneInt64 should return 0: "+test.TestCmpListOneInt64());
+  System.out.println("TestCmpListTwoInt64 should return 0: "+test.TestCmpListTwoInt64());
+  System.out.println("TestCmpListThreeInt64 should return 0: "+test.TestCmpListThreeInt64());
+  System.out.println("TestCmpListRangesOneInt64 should return 0: "+test.TestCmpListRangesOneInt64());
+  System.out.println("TestCmpListRangesTwoInt64 should return 0: "+test.TestCmpListRangesTwoInt64());
+  System.out.println("testsqr should return 0: "+test.testsqr());
+  System.out.println("testtrunc should return 0: "+test.testtrunc());
+  System.out.println("testdynarr should return 0: "+test.testdynarr());
+  System.out.println("testdynarr2 should return 0: "+test.testdynarr2());
+  System.out.println("testbitcastintfloat should return 0: "+test.testbitcastintfloat());
+  System.out.println("testis should return 0: "+test.testis());
+  System.out.println("testneg should return 0: "+test.testneg());
+  System.out.println("testtry1 should return 0: "+test.testtry1());
+  System.out.println("testtry2 should return 0: "+test.testtry2());
+  System.out.println("testtryfinally1 should return 0: "+test.testtryfinally1());
+  System.out.println("testtryfinally2 should return 0: "+test.testtryfinally2());
+  System.out.println("testtryfinally3 should return 0: "+test.testtryfinally3());
+  System.out.println("testsmallarr1 should return 0: "+test.testsmallarr1());
+  System.out.println("testsmallarr2 should return 0: "+test.testsmallarr2());
+  System.out.println("testsmallarr3 should return 0: "+test.testsmallarr3());
+  System.out.println("testsmallarr4 should return 0: "+test.testsmallarr4());
+  System.out.println("testopenarr1 should return 0: "+test.testopenarr1());
+  System.out.println("testopenarr2 should return 0: "+test.testopenarr2());
+  System.out.println("testopenarr3 should return 0: "+test.testopenarr3());
+  System.out.println("testopendynarr should return 0: "+test.testopendynarr());
+  System.out.println("testrec1 should return 0: "+test.testrec1());
+  System.out.println("testrec2 should return 0: "+test.testrec2());
+  System.out.println("testopenarr1rec should return 0: "+test.testopenarr1rec());
+  System.out.println("test.unitintconst should be 3: "+test.unitintconst);
+  System.out.println("test.unitfloatconst should be 2.0: "+test.unitfloatconst);
+  System.out.println("test.unitdoubleconst should be 0.1: "+test.unitdoubleconst);
+  System.out.println("TMyclass.classintconst should be 4: "+TMyClass.classintconst);
+  System.out.println("TMyclass.classfloatconst should be 3.0: "+TMyClass.classfloatconst);
+  
+  System.out.println();
+
+  intfclass = new tintfclass();
+  intf1 = intfclass;
+  intfclass2 = new tintfclass2();
+
+  System.out.println("intfclass.test(int) should return 10: "+intfclass.test(9));
+  System.out.println("intf1.test(int) should return 10: "+intf1.test(9));
+  System.out.println("intfclass.test(byte) should return 11: "+intfclass.test((byte)9));
+  System.out.println("intfclass2.intf4test(int64) should return -2: "+intfclass2.intf4test((long)-12345*2-133));
+  System.out.println("tinterface2.iconst should be 4: "+tinterface2.iconst);
+  
+  intfclass.Free();
+
+  System.out.println("  *** Note: string tests expect that Java source file is compiled with '-encoding utf-8' and test is run with '-Dfile.encoding=UTF-8'");
+  System.out.println("testunicodestring should return ~ê∂êºîƒ~©¬ -- ê = \u00ea ⊗ = \u2297: "+test.testunicodestring());
+  System.out.println("  equal: "+test.testunicodestring().equals("~ê∂êºîƒ~©¬"));
+  System.out.println("testunicodestring2 should return <\\\r\n\">: <"+test.testunicodestring2()+">");
+  System.out.println("  equal: "+test.testunicodestring2().equals("\\\r\n\""));
+  System.out.println("testunicodestring3 should return abcdef: "+test.testunicodestring3("abc"));
+  System.out.println("  equal: "+test.testunicodestring3("abc").equals("abcdef"));
+  System.out.println("testunicodestring4 should return ax2def: "+test.testunicodestring4("abcdef"));
+  System.out.println("  equal: "+test.testunicodestring4("abcdef").equals("ax2def"));
+  System.out.println("testunicodestring5 should return abcdefghij: "+test.testunicodestring5());
+  System.out.println("  equal: "+test.testunicodestring5().equals("abcdefghij"));
+  System.out.println("testunicodestring6 should return abcdefghi: "+test.testunicodestring6());
+  System.out.println("  equal: "+test.testunicodestring6().equals("abcdefghi"));
+  System.out.println("testunicodestring7 should return xbcdefghi: "+test.testunicodestring7());
+  System.out.println("  equal: "+test.testunicodestring7().equals("xbcdefghi"));
+
+  /* regular expression to transform numerical print statements into tests with exceptions:
+   * search: System\.out\.println\(".*should (?:return|be) ([^:]*): "\+([^\r]*)\);
+   * replace: if (\2 != \1)\r    throw new Exception("Invalid result for \2");
+   */
+
+  if (t.test(10,8) != 3)
+    throw new Exception("Invalid result for t.test(10,8)");
+  if (t.test(20,1) != -1)
+    throw new Exception("Invalid result for t.test(20,1)");
+  if (t.getintfield() != 123)
+    throw new Exception("Invalid result for t.getintfield()");
+  if (t.getstaticbytefield() != 42)
+    throw new Exception("Invalid result for t.getstaticbytefield()");
+  if (test.myrec.a != 42)
+    throw new Exception("Invalid result for test.myrec.a");
+  if (test.myrec.b != 1234)
+    throw new Exception("Invalid result for test.myrec.b");
+  if (test.tcl != 4)
+    throw new Exception("Invalid result for test.tcl");
+  if (test.tcrec.a != 1)
+    throw new Exception("Invalid result for test.tcrec.a");
+  if (test.tcrec.e != 5)
+    throw new Exception("Invalid result for test.tcrec.e");
+  if (test.tcnestrec.r.d != 4)
+    throw new Exception("Invalid result for test.tcnestrec.r.d");
+  if (test.tcnestrec.arr[1] != 6)
+    throw new Exception("Invalid result for test.tcnestrec.arr[1]");
+  if (TMyClass.gettestglobal() != 654321)
+    throw new Exception("Invalid result for TMyClass.gettestglobal()");
+  if (TMyClass.staticmul3(3) != 9)
+    throw new Exception("Invalid result for TMyClass.staticmul3(3)");
+  if (test.testset() != 0)
+    throw new Exception("Invalid result for test.testset()");
+  if (test.testloop() != 0)
+    throw new Exception("Invalid result for test.testloop()");
+  if (test.testfloat() != 0)
+    throw new Exception("Invalid result for test.testfloat()");
+  if (test.testint2real() != 0)
+    throw new Exception("Invalid result for test.testint2real()");
+  if (test.testcnvint1() != 0)
+    throw new Exception("Invalid result for test.testcnvint1()");
+  if (test.TestCmpListOneShort() != 0)
+    throw new Exception("Invalid result for test.TestCmpListOneShort()");
+  if (test.TestCmpListTwoShort() != 0)
+    throw new Exception("Invalid result for test.TestCmpListTwoShort()");
+  if (test.TestCmpListOneWord() != 0)
+    throw new Exception("Invalid result for test.TestCmpListOneWord()");
+  if (test.TestCmpListTwoWord() != 0)
+    throw new Exception("Invalid result for test.TestCmpListTwoWord()");
+  if (test.TestCmpListRangesOneShort() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesOneShort()");
+  if (test.TestCmpListRangesTwoShort() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesTwoShort()");
+  if (test.TestCmpListRangesOneWord() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesOneWord()");
+  if (test.TestCmpListRangesTwoWord() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesTwoWord()");
+  if (test.TestCmpListRangesThreeWord() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesThreeWord()");
+  if (test.TestCmpListOneInt64() != 0)
+    throw new Exception("Invalid result for test.TestCmpListOneInt64()");
+  if (test.TestCmpListTwoInt64() != 0)
+    throw new Exception("Invalid result for test.TestCmpListTwoInt64()");
+  if (test.TestCmpListThreeInt64() != 0)
+    throw new Exception("Invalid result for test.TestCmpListThreeInt64()");
+  if (test.TestCmpListRangesOneInt64() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesOneInt64()");
+  if (test.TestCmpListRangesTwoInt64() != 0)
+    throw new Exception("Invalid result for test.TestCmpListRangesTwoInt64()");
+  if (test.testsqr() != 0)
+    throw new Exception("Invalid result for test.testsqr()");
+  if (test.testtrunc() != 0)
+    throw new Exception("Invalid result for test.testtrunc()");
+  if (test.testdynarr() != 0)
+    throw new Exception("Invalid result for test.testdynarr()");
+  if (test.testdynarr2() != 0)
+    throw new Exception("Invalid result for test.testdynarr2()");
+  if (test.testbitcastintfloat() != 0)
+    throw new Exception("Invalid result for test.testbitcastintfloat()");
+  if (test.testis() != 0)
+    throw new Exception("Invalid result for test.testis()");
+  if (test.testneg() != 0)
+    throw new Exception("Invalid result for test.testneg()");
+  if (test.testtry1() != 0)
+    throw new Exception("Invalid result for test.testtry1()");
+  if (test.testtry2() != 0)
+    throw new Exception("Invalid result for test.testtry2()");
+  if (test.testtryfinally1() != 0)
+    throw new Exception("Invalid result for test.testtryfinally1()");
+  if (test.testtryfinally2() != 0)
+    throw new Exception("Invalid result for test.testtryfinally2()");
+  if (test.testtryfinally3() != 0)
+    throw new Exception("Invalid result for test.testtryfinally3()");
+  if (test.testsmallarr1() != 0)
+    throw new Exception("Invalid result for test.testsmallarr1()");
+  if (test.testsmallarr2() != 0)
+    throw new Exception("Invalid result for test.testsmallarr2()");
+  if (test.testsmallarr3() != 0)
+    throw new Exception("Invalid result for test.testsmallarr3()");
+  if (test.testsmallarr4() != 0)
+    throw new Exception("Invalid result for test.testsmallarr4()");
+  if (test.testopenarr1() != 0)
+    throw new Exception("Invalid result for test.testopenarr1()");
+  if (test.testopenarr2() != 0)
+    throw new Exception("Invalid result for test.testopenarr2()");
+  if (test.testopenarr3() != 0)
+    throw new Exception("Invalid result for test.testopenarr3()");
+  if (test.testopendynarr() != 0)
+    throw new Exception("Invalid result for test.testopendynarr()");
+  if (test.unitintconst != 3)
+    throw new Exception("Invalid result for test.unitintconst");
+  if (test.unitfloatconst != 2.0)
+    throw new Exception("Invalid result for test.unitfloatconst");
+  if (test.unitdoubleconst != 0.1)
+    throw new Exception("Invalid result for test.unitdoubleconst");
+  if (TMyClass.classintconst != 4)
+    throw new Exception("Invalid result for TMyClass.classintconst");
+  if (TMyClass.classfloatconst != 3.0)
+    throw new Exception("Invalid result for TMyClass.classfloatconst");
+  if (TMyClass.classdoubleconst != 0.3)
+    throw new Exception("Invalid result for TMyClass.classdoubleconst");
+  if (intfclass.test(9) != 10)
+    throw new Exception("Invalid result for intfclass.test(9)");
+  if (intf1.test(9) != 10)
+    throw new Exception("Invalid result for intf1.test(9)");
+  if (intfclass.test((byte)9) != 11)
+    throw new Exception("Invalid result for intfclass.test((byte)9)");
+  if (intfclass2.intf4test((long)-12345*2-133) != -2)
+    throw new Exception("Invalid result for intfclass2.intf4test((long)-12345*2-133)");
+  if (tinterface2.iconst != 4)
+    throw new Exception("Invalid result for tinterface2.iconst");
+  if (test.testrec1() != 0)
+    throw new Exception("Invalid result for test.testrec1()");
+  if (test.testopenarr1rec() != 0)
+    throw new Exception("Invalid result for test.testopenarr1rec()");
+  if (test.testrec2() != 0)
+    throw new Exception("Invalid result for test.testrec2()");
+
+
+}
+
+}

tests/test/jvm/classlist.pp

@@ -0,0 +1,30 @@
+program classlist;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+ T1 = class
+ end;
+
+ CT1 = class of T1;
+
+function test : string;
+var
+ T : T1;
+ C : CT1;
+ L : JUArrayList;
+begin
+ T := T1.Create;
+ C := CT1(JLObject(T).getClass);
+ L := JUArrayList.Create;
+ L.add(JLObject(C)); // ???
+ if ct1(l.get(0))<>t1 then
+   raise JLException.create('error');
+end;
+
+begin
+  test;
+end.

tests/test/jvm/classmeth.pp

@@ -0,0 +1,43 @@
+program classmeth;
+
+{$mode delphi}
+
+type
+ TElCustomCryptoProviderClass = class of TElCustomCryptoProvider;
+ TElCustomCryptoProvider = class
+   class procedure SetAsDefault;
+   class procedure DoSetAsDefault(Value : TElCustomCryptoProviderClass);
+ end;
+
+ tc2 = class(TElCustomCryptoProvider)
+   class procedure SetAsDefault; //reintroduce;
+ end;
+
+
+var
+  x: TElCustomCryptoProviderClass;
+
+class procedure TElCustomCryptoProvider.SetAsDefault;
+begin
+ DoSetAsDefault(Self); /// Illegal expression
+end;
+
+class procedure TElCustomCryptoProvider.DoSetAsDefault(Value : TElCustomCryptoProviderClass);
+begin
+// SetDefaultCryptoProviderType(Value);
+  x:=value;
+end;
+
+class procedure tc2.SetAsDefault;
+begin
+  DoSetAsDefault(Self);
+end;
+
+begin
+  TElCustomCryptoProvider.SetAsDefault;
+  if x<>TElCustomCryptoProvider then
+    raise JLException.create('first');
+  tc2.SetAsDefault;
+  if x<>tc2 then
+    raise JLException.create('second');
+end.

tests/test/jvm/forw.pp

@@ -0,0 +1,33 @@
+{ %norun }
+
+program forw;
+
+{$mode delphi}
+
+type
+ TC = class
+ public
+    procedure execute;
+ end;
+
+procedure tc.execute;
+
+       procedure nested1; forward;
+
+       procedure nested2;
+       begin
+
+       end;
+
+       procedure nested1;
+       begin
+
+       end;
+
+begin
+
+end;
+
+
+begin
+end.

tests/test/jvm/getbit.pp

@@ -0,0 +1,22 @@
+program getbit;
+
+{$mode delphi}
+
+type
+  plint = class
+    digits: array of byte;
+  end;
+
+function LGetBit(A: PLInt; Bit: Cardinal): Integer;
+begin
+  Result := (A.Digits[(Bit - 1) shr 5 + 1] shr ((Bit - 1) and $1F{(Bit - 1) mod 32})) and 1;
+end;
+
+var
+  p: plint;
+begin
+  p:=plint.create;
+  setlength(p.digits,10);
+  lgetbit(p,4);
+end.
+

tests/test/jvm/nested.pp

@@ -0,0 +1,19 @@
+{ %norun }
+program nested;
+
+function test : string;
+var
+ a, b : integer;
+
+ function work : integer;
+ begin
+   a := 1;
+   b := 2;
+ end;
+
+begin
+ work;
+end;
+
+begin
+end.

tests/test/jvm/outpara.pp

@@ -0,0 +1,27 @@
+{$mode objfpc}
+
+unit outpara;
+
+interface
+
+procedure test(out l: string);
+procedure main(args: array of string);
+
+implementation
+
+procedure test(out l: string);
+begin
+  l:='abc';
+end;
+
+procedure main(args: array of string);
+var
+  x: string;
+begin
+  test(x);
+  if x<>'abc' then
+    raise jlexception.Create('wrong')
+end;
+
+end.
+

tests/test/jvm/sort.pp

@@ -0,0 +1,30 @@
+program sort;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+function test : string;
+var
+ sa : array of JLObject;
+ L : JUList;
+ i : integer;
+begin
+ SetLength(sa, 3);
+ sa[0] := JLString(string('2'));
+ sa[1] := JLString(string('3'));
+ sa[2] := JLString(string('1'));
+ L := JUArrays.asList(sa);
+ JUCollections.sort(L);
+
+ Result := '';
+ for i := 0 to L.size() - 1 do
+   Result := Result + string(L.get(i)) + string(' ');
+end;
+
+begin
+  jlsystem.fout.println(test);
+  if test<>'1 2 3 ' then
+    raise JLException.create;
+end.

tests/test/jvm/tabs.pp

@@ -0,0 +1,309 @@
+{ Part of System unit testsuit        }
+{ Carl Eric Codere Copyright (c) 2002 }
+program tabs;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+{$endif}
+
+
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
+{$ifndef MACOS}
+{$APPTYPE CONSOLE}
+{$else}
+{$APPTYPE TOOL}
+{$endif}
+
+{$R-}
+{$Q-}
+
+const
+  RESULT_ONE_INT = 65536;
+  VALUE_ONE_INT = -65536;
+  RESULT_CONST_ONE_INT = abs(VALUE_ONE_INT);
+  RESULT_TWO_INT = 12345;
+  VALUE_TWO_INT = 12345;
+  RESULT_CONST_TWO_INT = abs(VALUE_TWO_INT);
+
+  RESULT_THREE_INT = 2147483647;
+  VALUE_THREE_INT = -2147483647;
+  RESULT_CONST_THREE_INT = abs(VALUE_THREE_INT);
+  RESULT_FOUR_INT = 2147483647;
+  VALUE_FOUR_INT = 2147483647;
+  RESULT_CONST_FOUR_INT = abs(VALUE_FOUR_INT);
+
+
+  RESULT_ONE_REAL = 12345.6789;
+  VALUE_ONE_REAL = -12345.6789;
+  RESULT_CONST_ONE_REAL = abs(VALUE_ONE_REAL);
+  RESULT_TWO_REAL = 54321.6789E+02;
+  VALUE_TWO_REAL = 54321.6789E+02;
+  RESULT_CONST_TWO_REAL = abs(VALUE_TWO_REAL);
+
+  RESULT_THREE_REAL = 0.0;
+  VALUE_THREE_REAL = 0.0;
+  RESULT_CONST_THREE_REAL = abs(VALUE_THREE_REAL);
+  RESULT_FOUR_REAL = 12.0;
+  VALUE_FOUR_REAL = -12.0;
+  RESULT_CONST_FOUR_REAL = abs(VALUE_FOUR_REAL);
+
+
+procedure fail;
+ begin
+  WriteLn('Failure!');
+  halt(1);
+ end;
+
+
+{$ifndef SKIP_CURRENCY_TEST}
+ procedure test_abs_currency;
+  var
+   _result : boolean;
+   value : currency;
+   value1: currency;
+  begin
+    Write('Abs() test with currency type...');
+    _result := true;
+
+    value := VALUE_ONE_REAL;
+    if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
+       _result := false;
+
+    value := VALUE_TWO_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
+       _result := false;
+
+    value := VALUE_FOUR_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
+       _result := false;
+
+    value := VALUE_ONE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_ONE_REAL) then
+       _result := false;
+
+    value := VALUE_TWO_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_THREE_REAL) then
+       _result := false;
+
+    value := VALUE_FOUR_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
+       _result := false;
+
+
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+{$endif SKIP_CURRENCY_TEST}
+
+
+
+ procedure test_abs_int64;
+  var
+   _result : boolean;
+   value : int64;
+   value1: int64;
+  begin
+    Write('Abs() test with int64 type...');
+    _result := true;
+
+   value := VALUE_ONE_INT;
+    if (abs(value) <> (RESULT_CONST_ONE_INT))  then
+       _result := false;
+
+
+    value := VALUE_TWO_INT;
+    if abs(value) <> (RESULT_CONST_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    if abs(value) <> (RESULT_CONST_THREE_INT) then
+       _result := false;
+
+    value := VALUE_FOUR_INT;
+    if abs(value) <> (RESULT_CONST_FOUR_INT) then
+       _result := false;
+
+    value := VALUE_ONE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_ONE_INT) then
+       _result := false;
+
+    value := VALUE_TWO_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_THREE_INT) then
+       _result := false;
+
+    value := VALUE_FOUR_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_FOUR_INT) then
+       _result := false;
+
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+
+ procedure test_abs_longint;
+  var
+   _result : boolean;
+   value : longint;
+   value1: longint;
+   vsingle : single;
+   vdouble : double;
+   vextended : extended;
+  begin
+    Write('Abs() test with longint type...');
+    _result := true;
+
+   value := VALUE_ONE_INT;
+    if (abs(value) <> (RESULT_CONST_ONE_INT))  then
+       _result := false;
+
+
+    value := VALUE_TWO_INT;
+    if abs(value) <> (RESULT_CONST_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    if abs(value) <> (RESULT_CONST_THREE_INT) then
+       _result := false;
+
+    value := VALUE_FOUR_INT;
+    if abs(value) <> (RESULT_CONST_FOUR_INT) then
+       _result := false;
+
+    value := VALUE_ONE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_ONE_INT) then
+       _result := false;
+
+    value := VALUE_TWO_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_TWO_INT) then
+       _result := false;
+
+    value := VALUE_THREE_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_THREE_INT) then
+       _result := false;
+
+    value := VALUE_FOUR_INT;
+    value1 := abs(value);
+    if value1 <> (RESULT_FOUR_INT) then
+       _result := false;
+
+    value := VALUE_ONE_INT;
+    vsingle := abs(value);
+    if (round(vsingle) <> RESULT_ONE_INT) then
+      _result := false;
+
+    value := VALUE_ONE_INT;
+    vdouble := abs(value);
+    if (round(vdouble) <> RESULT_ONE_INT) then
+      _result := false;
+
+    value := VALUE_ONE_INT;
+    vextended := abs(value);
+    if (round(vextended) <> RESULT_ONE_INT) then
+      _result := false;
+
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+ procedure test_abs_real;
+  var
+   _result : boolean;
+   value : real;
+   value1: real;
+  begin
+    _result := true;
+    Write('Abs() test with real type...');
+
+    value := VALUE_ONE_REAL;
+    if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
+       _result := false;
+
+    value := VALUE_TWO_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
+       _result := false;
+
+    value := VALUE_FOUR_REAL;
+    if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
+       _result := false;
+
+    value := VALUE_ONE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_ONE_REAL) then
+       _result := false;
+
+    value := VALUE_TWO_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_TWO_REAL) then
+       _result := false;
+
+    value := VALUE_THREE_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_THREE_REAL) then
+       _result := false;
+
+    value := VALUE_FOUR_REAL;
+    value1 := abs(value);
+    if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
+       _result := false;
+
+    if not _result then
+      fail
+    else
+      WriteLn('Success!');
+  end;
+
+var
+ r: longint;
+ _success : boolean;
+ l: boolean;
+Begin
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
+  test_abs_currency;
+{$endif SKIP_CURRENCY_TEST}
+  test_abs_real;
+  test_abs_longint;
+  test_abs_int64;
+end.

tests/test/jvm/taddset.pp

@@ -0,0 +1,655 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondadd()                                      }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondsetelement()                             }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS:                                                       }
+{                                                                }
+{                                                                }
+{                                                                }
+{****************************************************************}
+
+Program taddset;
+
+{$modeswitch exceptions}
+
+{$macro on}
+{$define write:=jlsystem.fout.print}
+{$define writeln:=jlsystem.fout.println}
+
+uses
+  jdk15;
+
+procedure halt(l: longint);
+begin
+  write('exit code: ');
+  writeln(l);
+  raise jlexception.create('error');
+end;
+
+var
+  Err : boolean;
+
+type
+       { DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! }
+       tsmallenum = (dA,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr);
+       tasmop = (A_ABCD,
+         A_ADD,A_ADDA,A_ADDI,A_ADDQ,A_ADDX,A_AND,A_ANDI,
+         A_ASL,A_ASR,A_BCC,A_BCS,A_BEQ,A_BGE,A_BGT,A_BHI,
+         A_BLE,A_BLS,A_BLT,A_BMI,A_BNE,A_BPL,A_BVC,A_BVS,
+         A_BCHG,A_BCLR,A_BRA,A_BSET,A_BSR,A_BTST,A_CHK,
+         A_CLR,A_CMP,A_CMPA,A_CMPI,A_CMPM,A_DBCC,A_DBCS,A_DBEQ,A_DBGE,
+         A_DBGT,A_DBHI,A_DBLE,A_DBLS,A_DBLT,A_DBMI,A_DBNE,A_DBRA,
+         A_DBPL,A_DBT,A_DBVC,A_DBVS,A_DBF,A_DIVS,A_DIVU,
+         A_EOR,A_EORI,A_EXG,A_ILLEGAL,A_EXT,A_JMP,A_JSR,
+         A_LEA,A_LINK,A_LSL,A_LSR,A_MOVE,A_MOVEA,A_MOVEI,A_MOVEQ,
+         A_MOVEM,A_MOVEP,A_MULS,A_MULU,A_NBCD,A_NEG,A_NEGX,
+         A_NOP,A_NOT,A_OR,A_ORI,A_PEA,A_ROL,A_ROR,A_ROXL,
+         A_ROXR,A_RTR,A_RTS,A_SBCD,A_SCC,A_SCS,A_SEQ,A_SGE,
+         A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,A_SNE,
+         A_SPL,A_ST,A_SVC,A_SVS,A_SF,A_SUB,A_SUBA,A_SUBI,A_SUBQ,
+         A_SUBX,A_SWAP,A_TAS,A_TRAP,A_TRAPV,A_TST,A_UNLK,
+         A_RTE,A_RESET,A_STOP,
+         { MC68010 instructions }
+         A_BKPT,A_MOVEC,A_MOVES,A_RTD,
+         { MC68020 instructions }
+         A_BFCHG,A_BFCLR,A_BFEXTS,A_BFEXTU,A_BFFFO,
+         A_BFINS,A_BFSET,A_BFTST,A_CALLM,A_CAS,A_CAS2,
+         A_CHK2,A_CMP2,A_DIVSL,A_DIVUL,A_EXTB,A_PACK,A_RTM,
+         A_TRAPCC,A_TRACS,A_TRAPEQ,A_TRAPF,A_TRAPGE,A_TRAPGT,
+         A_TRAPHI,A_TRAPLE,A_TRAPLS,A_TRAPLT,A_TRAPMI,A_TRAPNE,
+         A_TRAPPL,A_TRAPT,A_TRAPVC,A_TRAPVS,A_UNPK,
+         { FPU Processor instructions - directly supported only. }
+         { IEEE aware and misc. condition codes not supported   }
+         A_FABS,A_FADD,
+         A_FBEQ,A_FBNE,A_FBNGT,A_FBGT,A_FBGE,A_FBNGE,
+         A_FBLT,A_FBNLT,A_FBLE,A_FBGL,A_FBNGL,A_FBGLE,A_FBNGLE,
+         A_FDBEQ,A_FDBNE,A_FDBGT,A_FDBNGT,A_FDBGE,A_FDBNGE,
+         A_FDBLT,A_FDBNLT,A_FDBLE,A_FDBGL,A_FDBNGL,A_FDBGLE,A_FBDNGLE,
+         A_FSEQ,A_FSNE,A_FSGT,A_FSNGT,A_FSGE,A_FSNGE,
+         A_FSLT,A_FSNLT,A_FSLE,A_FSGL,A_FSNGL,A_FSGLE,A_FSNGLE,
+         A_FCMP,A_FDIV,A_FMOVE,A_FMOVEM,
+         A_FMUL,A_FNEG,A_FNOP,A_FSQRT,A_FSUB,A_FSGLDIV,
+         A_FSFLMUL,A_FTST,
+         A_FTRAPEQ,A_FTRAPNE,A_FTRAPGT,A_FTRAPNGT,A_FTRAPGE,A_FTRAPNGE,
+         A_FTRAPLT,A_FTRAPNLT,A_FTRAPLE,A_FTRAPGL,A_FTRAPNGL,A_FTRAPGLE,A_FTRAPNGLE,
+         { Protected instructions }
+         A_CPRESTORE,A_CPSAVE,
+         { FPU Unit protected instructions                    }
+         { and 68030/68851 common MMU instructions            }
+         { (this may include 68040 MMU instructions)          }
+         A_FRESTORE,A_FSAVE,A_PFLUSH,A_PFLUSHA,A_PLOAD,A_PMOVE,A_PTEST,
+         { Useful for assembly langage output }
+         A_LABEL,A_NONE);
+
+
+
+type
+  topset = set of tasmop;
+  tsmallset = set of tsmallenum;
+
+const
+
+   { NORMAL SETS }
+   constset1 : array[1..3] of topset =
+   (
+       { 66 }    { 210 }  { 225 }
+     ([A_MOVE,    { 66  : LONG 2 - BIT 2  }
+       A_FTST,    { 210 : LONG 6 - BIT 18 }
+       A_CPSAVE]),{ 225 : LONG 7 - BIT 1 }
+       { 1..8 }
+     ([A_ADD..A_ASL]),
+       { 134 }
+     ([A_CHK2])
+   );
+
+   constset2 : array[1..3] of topset =
+   (
+     ([A_MOVE,A_FTST,A_CPSAVE]),
+     ([A_ADD..A_ASL]),
+     ([A_CHK2])
+   );
+
+   { SMALL SETS }
+   constset3 : array[1..3] of tsmallset =
+   (
+     ([DA,             { 0 :  LONG 0 : bit 0 }
+       DD,             { 3 :  LONG 0 : bit 3 }
+       DM]),           { 12 :  LONG 0 : bit 12  }
+     ([DB..DI]),       { 1..8 : LONG 0 : bits 1-8  }
+     ([DR])            { 17 :  LONG 0 : bit 17 }
+   );
+
+   constset4 : array[1..3] of tsmallset =
+   (
+     ([DA,DD,DM]),
+     ([DB..DI]),
+     ([DR])
+   );
+
+
+ procedure CheckPassed(passed:boolean);
+ begin
+   if passed then
+     WriteLn('Success.')
+   else
+     begin
+       WriteLn('Failure.');
+       Halt(1);
+       Err:=true;
+     end;
+ end;
+
+ procedure SetTestEqual;
+ { FPC_SET_COMP_SETS }
+  var
+    op2list :set of tasmop;
+    oplist: set of tasmop;
+    passed : boolean;
+  Begin
+   Write('Normal Set == Normal Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if not (constset1[2] = constset2[2]) then
+     passed := false;
+   if (constset1[1] = constset2[2]) then
+     passed := false;
+   if not (constset1[1] = [A_MOVE,A_FTST,A_CPSAVE]) then
+     passed := false;
+    CheckPassed(passed);
+  end;
+
+ procedure SetTestNotEqual;
+ { FPC_SET_COMP_SETS }
+  var
+    op2list :set of tasmop;
+    oplist: set of tasmop;
+    passed : boolean;
+  Begin
+   Write('Normal Set <> Normal Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if (constset1[2] <> constset2[2]) then
+     passed := false;
+   if not (constset1[1] <> constset2[2]) then
+     passed := false;
+{   if ( [A_ADD] <> [A_ADD] ) then optimized out.
+     passed := false;
+   if ( [A_BLE..A_BPL] <> [A_BLE..A_BPL] ) then
+     passed := false; }
+   if (constset1[1] <> [A_MOVE,A_FTST,A_CPSAVE]) then
+     passed := false;
+    CheckPassed(passed);
+  end;
+
+  procedure SetTestLt;
+  var
+    op2list :set of tasmop;
+    oplist: set of tasmop;
+    passed : boolean;
+   begin
+    Write('Normal Set <= Normal Set test...');
+    passed := true;
+    if constset1[1] <= constset2[2] then
+      passed := false;
+    oplist := [];
+    op2list := [A_MOVE];
+    if op2list <= oplist then
+     passed := false;
+    oplist := [A_MOVE,A_CPRESTORE..A_CPSAVE];
+    if oplist <= op2list then
+     passed := false;
+    CheckPassed(passed);
+   end;
+
+  Procedure SetTestAddOne;
+ { FPC_SET_SET_BYTE }
+ { FPC_SET_ADD_SETS }
+    var
+     op : tasmop;
+     oplist: set of tasmop;
+  Begin
+    Write('Set + Set element testing...');
+    op:=A_LABEL;
+    oplist:=[];
+    oplist:=oplist+[op];
+    CheckPassed(oplist = [A_LABEL]);
+  end;
+
+Procedure SetTestAddTwo;
+{ SET_ADD_SETS }
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+Begin
+ Write('Complex Set + Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[A_MOVE]+[A_JSR];
+ op2list:=[A_LABEL];
+ oplist:=op2list+oplist;
+ CheckPassed(oplist = [A_MOVE,A_JSR,A_LABEL]);
+end;
+
+
+
+
+
+Procedure SetTestSubOne;
+{ SET_SUB_SETS }
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+ op :tasmop;
+ passed : boolean;
+Begin
+ Write('Set - Set element testing...');
+ passed := true;
+ op2list:=[];
+ oplist:=[];
+ op := A_TRACS;
+ oplist:=[A_MOVE]+[A_JSR]+[op];
+ op2list:=[A_MOVE]+[A_JSR];
+ oplist:=oplist-op2list;
+ if oplist <> [A_TRACS] then
+   passed := false;
+
+ oplist:=[A_MOVE]+[A_JSR]+[op];
+ op2list:=[A_MOVE]+[A_JSR];
+ oplist:=op2list-oplist;
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+Procedure SetTestSubTwo;
+{ FPC_SET_SUB_SETS }
+const
+ b: tasmop = (A_BSR);
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+ op : tasmop;
+ passed : boolean;
+Begin
+ Write('Complex Set - Set element testing...');
+ op := A_BKPT;
+ passed := true;
+ oplist:=[A_MOVE]+[A_JSR]-[op];
+ op2list:=[A_MOVE]+[A_JSR];
+ if oplist <> op2list then
+   passed := false;
+ oplist := [A_MOVE];
+ oplist := oplist - [A_MOVE];
+ if oplist <> [] then
+   passed := false;
+ oplist := oplist + [b];
+ if oplist <> [b] then
+   passed := false;
+ oplist := oplist - [b];
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+Procedure SetTestMulSets;
+{ FPC_SET_MUL_SETS }
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+ passed : boolean;
+Begin
+ passed := true;
+ Write('Set * Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[A_MOVE]+[A_JSR];
+ op2list:=[A_MOVE];
+ oplist:=oplist*op2list;
+ if oplist <> [A_JSR] then
+   passed := false;
+ oplist := [A_MOVE,A_FTST];
+ op2list := [A_MOVE,A_FTST];
+ oplist := oplist * op2list;
+ if oplist <> [A_MOVE,A_FTST] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SetTestRange;
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+ passed : boolean;
+ op1 : tasmop;
+ op2 : tasmop;
+begin
+ passed := true;
+ Write('Range Set + element testing...');
+ op1 := A_ADD;
+ op2 := A_ASL;
+ oplist := [];
+ oplist := [op1..op2];
+ if oplist <> constset1[2] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SetTestByte;
+var
+ op2list :set of tasmop;
+ oplist: set of tasmop;
+ passed : boolean;
+ op1 : tasmop;
+ op2 : tasmop;
+ op : tasmop;
+begin
+ Write('Simple Set + element testing...');
+ passed := true;
+ op := A_LABEL;
+ oplist := [A_MOVE,op,A_JSR];
+ if oplist <> [A_MOVE,A_LABEL,A_JSR] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+{------------------------------ TESTS FOR SMALL VALUES ---------------------}
+ procedure SmallSetTestEqual;
+  var
+    op2list :set of tsmallenum;
+    oplist: set of tsmallenum;
+    passed : boolean;
+  Begin
+   Write('Small Set == Small Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if not (constset3[2] = constset4[2]) then
+     passed := false;
+   if (constset3[1] = constset4[2]) then
+     passed := false;
+   if not (constset3[1] = [DA,DD,DM]) then
+     passed := false;
+ CheckPassed(passed);
+  end;
+
+ procedure SmallSetTestNotEqual;
+  var
+    op2list :set of tsmallenum;
+    oplist: set of tsmallenum;
+    passed : boolean;
+  Begin
+   Write('Small Set <> Small Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if (constset3[2] <> constset4[2]) then
+     passed := false;
+   if not (constset3[1] <> constset4[2]) then
+     passed := false;
+{   if ( [A_ADD] <> [A_ADD] ) then optimized out.
+     passed := false;
+   if ( [A_BLE..A_BPL] <> [A_BLE..A_BPL] ) then
+     passed := false; }
+   if (constset3[1] <> [DA,DD,DM]) then
+     passed := false;
+ CheckPassed(passed);
+  end;
+
+  procedure SmallSetTestLt;
+  var
+    op2list :set of tsmallenum;
+    oplist: set of tsmallenum;
+    passed : boolean;
+   begin
+    Write('Small Set <= Small Set test...');
+    passed := true;
+    if constset3[1] <= constset4[2] then
+      passed := false;
+    oplist := [];
+    op2list := [DC];
+    if op2list <= oplist then
+     passed := false;
+    oplist := [DC,DF..DM];
+    if oplist <= op2list then
+     passed := false;
+ CheckPassed(passed);
+   end;
+
+  Procedure SmallSetTestAddOne;
+    var
+     op : tsmallenum;
+     oplist: set of tsmallenum;
+  Begin
+    Write('Small Set + Small Set element testing...');
+    op:=DG;
+    oplist:=[];
+    oplist:=oplist+[op];
+    CheckPassed( oplist = [DG] );
+  end;
+
+Procedure SmallSetTestAddTwo;
+var
+ op2list :set of tsmallenum;
+ oplist: set of tsmallenum;
+Begin
+ Write('Small Complex Set + Small Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[DG]+[DI];
+ op2list:=[DM];
+ oplist:=op2list+oplist;
+ CheckPassed( oplist = [DG,DI,DM] );
+end;
+
+
+Procedure SmallSetTestSubOne;
+var
+ op2list :set of tsmallenum;
+ oplist: set of tsmallenum;
+ op :tsmallenum;
+ passed : boolean;
+Begin
+ Write('Small Set - Small Set element testing...');
+ passed := true;
+ op2list:=[];
+ oplist:=[];
+ op := DL;
+ oplist:=[DG]+[DI]+[op];
+ op2list:=[DG]+[DI];
+ oplist:=oplist-op2list;
+ if oplist <> [DL] then
+   passed := false;
+
+ oplist:=[DG]+[DI]+[op];
+ op2list:=[DG]+[DI];
+ oplist:=op2list-oplist;
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+Procedure SmallSetTestSubTwo;
+const
+ b: tsmallenum = (DH);
+var
+ op2list :set of tsmallenum;
+ oplist: set of tsmallenum;
+ op : tsmallenum;
+ passed : boolean;
+Begin
+ Write('Small Complex Set - Small Set element testing...');
+ op := DL;
+ passed := true;
+ oplist:=[DG]+[DI]-[op];
+ op2list:=[DG]+[DI];
+ if oplist <> op2list then
+   passed := false;
+ oplist := [DG];
+ oplist := oplist - [DG];
+ if oplist <> [] then
+   passed := false;
+ oplist := oplist + [b];
+ if oplist <> [b] then
+   passed := false;
+ oplist := oplist - [b];
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+Procedure SmallSetTestMulSets;
+var
+ op2list : set of tsmallenum;
+ oplist: set of tsmallenum;
+ passed : boolean;
+Begin
+ passed := true;
+ Write('Small Set * Small Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[DG]+[DI];
+ op2list:=[DG];
+ oplist:=oplist*op2list;
+ if oplist <> [DI] then
+   passed := false;
+ oplist := [DG,DK];
+ op2list := [DG,DK];
+ oplist := oplist * op2list;
+ if oplist <> [DG,DK] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SmallSetTestRange;
+var
+ op2list :set of tsmallenum;
+ oplist: set of tsmallenum;
+ passed : boolean;
+ op1 : tsmallenum;
+ op2 : tsmallenum;
+begin
+ passed := true;
+ Write('Small Range Set + element testing...');
+ op1 := DB;
+ op2 := DI;
+ oplist := [];
+ oplist := [op1..op2];
+ if oplist <> constset3[2] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SmallSetTestByte;
+var
+ op2list : set of tsmallenum;
+ oplist: set of tsmallenum;
+ passed : boolean;
+ op1 : tsmallenum;
+ op2 : tsmallenum;
+ op : tsmallenum;
+begin
+ Write('Small Simple Set + element testing...');
+ passed := true;
+ op := DD;
+ oplist := [DG,op,DI];
+ if oplist <> [DG,DD,DI] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+(*
+
+const
+ b: myenum = (dA);
+var
+ enum: set of myenum;
+ oplist: set of tasmop;
+ l : word;
+Begin
+  SetTestEqual;
+  SetTestNotEqual;
+{ small sets }
+ enum:=[];
+ { add }
+ enum:=enum+[da];
+ { subtract }
+ enum:=enum-[da];
+ if DA in enum then
+  WriteLn('Found A_LABEL');
+ { very large sets       }
+ { copy loop test        }
+ WRITELN('LARGE SETS:');
+ oplist := [A_LABEL];
+ { secondin test         }
+ if A_LABEL in oplist then
+  WriteLn('TESTING SIMPLE SECOND_IN: PASSED.');
+ { }
+ oplist:=[];
+ if A_LABEL in oplist then
+  WriteLn('SECOND IN FAILED.');
+{ SecondinSets;}
+ SetSetByte;
+ SetAddSets;
+ SetSubSets;
+ SetCompSets;
+ SetMulSets;
+ WRITELN('SMALL SETS:');
+ SmallInSets;
+ SmallAddSets;
+ SmallSubSets;
+ SmallCompSets;
+ SmallMulSets;
+ l:=word(A_CPRESTORE);
+ if l = word(A_CPRESTORE) then
+  Begin
+  end;
+
+*)
+Begin
+  WriteLn('----------------------- Normal sets -----------------------');
+  { Normal sets }
+  SetTestEqual;
+  SetTestNotEqual;
+  SetTestAddOne;
+  SetTestAddTwo;
+  SetTestSubOne;
+  SetTestSubTwo;
+  SetTestRange;
+  SetTestLt;
+  SetTestByte;
+  { Small sets }
+  WriteLn('----------------------- Small sets -----------------------');
+  SmallSetTestEqual;
+  SmallSetTestNotEqual;
+  SmallSetTestAddOne;
+  SmallSetTestAddTwo;
+  SmallSetTestSubOne;
+  SmallSetTestSubTwo;
+  SmallSetTestRange;
+  SmallSetTestLt;
+  SmallSetTestByte;
+
+  if Err then
+   Halt(1);
+end.

tests/test/jvm/taddsetint.pp

@@ -0,0 +1,658 @@
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{****************************************************************}
+{ NODE TESTED : secondadd()                                      }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondsetelement()                             }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS:                                                       }
+{                                                                }
+{                                                                }
+{                                                                }
+{****************************************************************}
+
+Program taddsetint;
+
+{$modeswitch exceptions}
+
+{$macro on}
+{$define write:=jlsystem.fout.print}
+{$define writeln:=jlsystem.fout.println}
+
+uses
+  jdk15;
+
+procedure halt(l: longint);
+begin
+  write('exit code: ');
+  writeln(l);
+  raise jlexception.create('error');
+end;
+
+var
+  Err : boolean;
+
+type
+       { DO NOT CHANGE THE VALUES OF THESE ENUMERATIONS! }
+       tsmallenum = (dA,dB,dC,dd,de,df,dg,dh,di,dj,dk,dl,dm,dn,dop,dp,dq,dr);
+       tasmop = (A_ABCD,
+         A_ADD,A_ADDA,A_ADDI,A_ADDQ,A_ADDX,A_AND,A_ANDI,
+         A_ASL,A_ASR,A_BCC,A_BCS,A_BEQ,A_BGE,A_BGT,A_BHI,
+         A_BLE,A_BLS,A_BLT,A_BMI,A_BNE,A_BPL,A_BVC,A_BVS,
+         A_BCHG,A_BCLR,A_BRA,A_BSET,A_BSR,A_BTST,A_CHK,
+         A_CLR,A_CMP,A_CMPA,A_CMPI,A_CMPM,A_DBCC,A_DBCS,A_DBEQ,A_DBGE,
+         A_DBGT,A_DBHI,A_DBLE,A_DBLS,A_DBLT,A_DBMI,A_DBNE,A_DBRA,
+         A_DBPL,A_DBT,A_DBVC,A_DBVS,A_DBF,A_DIVS,A_DIVU,
+         A_EOR,A_EORI,A_EXG,A_ILLEGAL,A_EXT,A_JMP,A_JSR,
+         A_LEA,A_LINK,A_LSL,A_LSR,A_MOVE,A_MOVEA,A_MOVEI,A_MOVEQ,
+         A_MOVEM,A_MOVEP,A_MULS,A_MULU,A_NBCD,A_NEG,A_NEGX,
+         A_NOP,A_NOT,A_OR,A_ORI,A_PEA,A_ROL,A_ROR,A_ROXL,
+         A_ROXR,A_RTR,A_RTS,A_SBCD,A_SCC,A_SCS,A_SEQ,A_SGE,
+         A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,A_SNE,
+         A_SPL,A_ST,A_SVC,A_SVS,A_SF,A_SUB,A_SUBA,A_SUBI,A_SUBQ,
+         A_SUBX,A_SWAP,A_TAS,A_TRAP,A_TRAPV,A_TST,A_UNLK,
+         A_RTE,A_RESET,A_STOP,
+         { MC68010 instructions }
+         A_BKPT,A_MOVEC,A_MOVES,A_RTD,
+         { MC68020 instructions }
+         A_BFCHG,A_BFCLR,A_BFEXTS,A_BFEXTU,A_BFFFO,
+         A_BFINS,A_BFSET,A_BFTST,A_CALLM,A_CAS,A_CAS2,
+         A_CHK2,A_CMP2,A_DIVSL,A_DIVUL,A_EXTB,A_PACK,A_RTM,
+         A_TRAPCC,A_TRACS,A_TRAPEQ,A_TRAPF,A_TRAPGE,A_TRAPGT,
+         A_TRAPHI,A_TRAPLE,A_TRAPLS,A_TRAPLT,A_TRAPMI,A_TRAPNE,
+         A_TRAPPL,A_TRAPT,A_TRAPVC,A_TRAPVS,A_UNPK,
+         { FPU Processor instructions - directly supported only. }
+         { IEEE aware and misc. condition codes not supported   }
+         A_FABS,A_FADD,
+         A_FBEQ,A_FBNE,A_FBNGT,A_FBGT,A_FBGE,A_FBNGE,
+         A_FBLT,A_FBNLT,A_FBLE,A_FBGL,A_FBNGL,A_FBGLE,A_FBNGLE,
+         A_FDBEQ,A_FDBNE,A_FDBGT,A_FDBNGT,A_FDBGE,A_FDBNGE,
+         A_FDBLT,A_FDBNLT,A_FDBLE,A_FDBGL,A_FDBNGL,A_FDBGLE,A_FBDNGLE,
+         A_FSEQ,A_FSNE,A_FSGT,A_FSNGT,A_FSGE,A_FSNGE,
+         A_FSLT,A_FSNLT,A_FSLE,A_FSGL,A_FSNGL,A_FSGLE,A_FSNGLE,
+         A_FCMP,A_FDIV,A_FMOVE,A_FMOVEM,
+         A_FMUL,A_FNEG,A_FNOP,A_FSQRT,A_FSUB,A_FSGLDIV,
+         A_FSFLMUL,A_FTST,
+         A_FTRAPEQ,A_FTRAPNE,A_FTRAPGT,A_FTRAPNGT,A_FTRAPGE,A_FTRAPNGE,
+         A_FTRAPLT,A_FTRAPNLT,A_FTRAPLE,A_FTRAPGL,A_FTRAPNGL,A_FTRAPGLE,A_FTRAPNGLE,
+         { Protected instructions }
+         A_CPRESTORE,A_CPSAVE,
+         { FPU Unit protected instructions                    }
+         { and 68030/68851 common MMU instructions            }
+         { (this may include 68040 MMU instructions)          }
+         A_FRESTORE,A_FSAVE,A_PFLUSH,A_PFLUSHA,A_PLOAD,A_PMOVE,A_PTEST,
+         { Useful for assembly langage output }
+         A_LABEL,A_NONE);
+         
+         tsmallenumint = ord(low(tsmallenum))..ord(high(tsmallenum));
+         tasmopint = ord(low(tasmop))..ord(high(tasmop));
+
+
+
+type
+  topset = set of tasmopint;
+  tsmallset = set of tsmallenumint;
+
+const
+
+   { NORMAL SETS }
+   constset1 : array[1..3] of topset =
+   (
+       { 66 }    { 210 }  { 225 }
+     ([ord(A_MOVE),    { 66  : LONG 2 - BIT 2  }
+       ord(A_FTST),    { 210 : LONG 6 - BIT 18 }
+       ord(A_CPSAVE)]),{ 225 : LONG 7 - BIT 1 }
+       { 1..8 }
+     ([ord(A_ADD)..ord(A_ASL)]),
+       { 134 }
+     ([ord(A_CHK2)])
+   );
+
+   constset2 : array[1..3] of topset =
+   (
+     ([ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]),
+     ([ord(A_ADD)..ord(A_ASL)]),
+     ([ord(A_CHK2)])
+   );
+
+   { SMALL SETS }
+   constset3 : array[1..3] of tsmallset =
+   (
+     ([ord(DA),             { 0 :  LONG 0 : bit 0 }
+       ord(DD),             { 3 :  LONG 0 : bit 3 }
+       ord(DM)]),           { 12 :  LONG 0 : bit 12  }
+     ([ord(DB)..ord(DI)]),       { 1..8 : LONG 0 : bits 1-8  }
+     ([ord(DR)])            { 17 :  LONG 0 : bit 17 }
+   );
+
+   constset4 : array[1..3] of tsmallset =
+   (
+     ([ord(DA),ord(DD),ord(DM)]),
+     ([ord(DB)..ord(DI)]),
+     ([ord(DR)])
+   );
+
+
+ procedure CheckPassed(passed:boolean);
+ begin
+   if passed then
+     WriteLn('Success.')
+   else
+     begin
+       WriteLn('Failure.');
+       Halt(1);
+       Err:=true;
+     end;
+ end;
+
+ procedure SetTestEqual;
+ { FPC_SET_COMP_SETS }
+  var
+    op2list :set of tasmopint;
+    oplist: set of tasmopint;
+    passed : boolean;
+  Begin
+   Write('Normal Set == Normal Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if not (constset1[2] = constset2[2]) then
+     passed := false;
+   if (constset1[1] = constset2[2]) then
+     passed := false;
+   if not (constset1[1] = [ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]) then
+     passed := false;
+    CheckPassed(passed);
+  end;
+
+ procedure SetTestNotEqual;
+ { FPC_SET_COMP_SETS }
+  var
+    op2list :set of tasmopint;
+    oplist: set of tasmopint;
+    passed : boolean;
+  Begin
+   Write('Normal Set <> Normal Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if (constset1[2] <> constset2[2]) then
+     passed := false;
+   if not (constset1[1] <> constset2[2]) then
+     passed := false;
+{   if ( [ord(A_ADD)] <> [ord(A_ADD)] ) then optimized out.
+     passed := false;
+   if ( [ord(A_BLE)..ord(A_BPL)] <> [ord(A_BLE)..ord(A_BPL)] ) then
+     passed := false; }
+   if (constset1[1] <> [ord(A_MOVE),ord(A_FTST),ord(A_CPSAVE)]) then
+     passed := false;
+    CheckPassed(passed);
+  end;
+
+  procedure SetTestLt;
+  var
+    op2list :set of tasmopint;
+    oplist: set of tasmopint;
+    passed : boolean;
+   begin
+    Write('Normal Set <= Normal Set test...');
+    passed := true;
+    if constset1[1] <= constset2[2] then
+      passed := false;
+    oplist := [];
+    op2list := [ord(A_MOVE)];
+    if op2list <= oplist then
+     passed := false;
+    oplist := [ord(A_MOVE),ord(A_CPRESTORE)..ord(A_CPSAVE)];
+    if oplist <= op2list then
+     passed := false;
+    CheckPassed(passed);
+   end;
+
+  Procedure SetTestAddOne;
+ { FPC_SET_SET_BYTE }
+ { FPC_SET_ADD_SETS }
+    var
+     op : tasmopint;
+     oplist: set of tasmopint;
+  Begin
+    Write('Set + Set element testing...');
+    op:=ord(A_LABEL);
+    oplist:=[];
+    oplist:=oplist+[op];
+    CheckPassed(oplist = [ord(A_LABEL)]);
+  end;
+
+Procedure SetTestAddTwo;
+{ SET_ADD_SETS }
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+Begin
+ Write('Complex Set + Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[ord(A_MOVE)]+[ord(A_JSR)];
+ op2list:=[ord(A_LABEL)];
+ oplist:=op2list+oplist;
+ CheckPassed(oplist = [ord(A_MOVE),ord(A_JSR),ord(A_LABEL)]);
+end;
+
+
+
+
+
+Procedure SetTestSubOne;
+{ SET_SUB_SETS }
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+ op :tasmopint;
+ passed : boolean;
+Begin
+ Write('Set - Set element testing...');
+ passed := true;
+ op2list:=[];
+ oplist:=[];
+ op := ord(A_TRACS);
+ oplist:=[ord(A_MOVE)]+[ord(A_JSR)]+[op];
+ op2list:=[ord(A_MOVE)]+[ord(A_JSR)];
+ oplist:=oplist-op2list;
+ if oplist <> [ord(A_TRACS)] then
+   passed := false;
+
+ oplist:=[ord(A_MOVE)]+[ord(A_JSR)]+[op];
+ op2list:=[ord(A_MOVE)]+[ord(A_JSR)];
+ oplist:=op2list-oplist;
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+Procedure SetTestSubTwo;
+{ FPC_SET_SUB_SETS }
+const
+ b: tasmopint = (ord(A_BSR));
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+ op : tasmopint;
+ passed : boolean;
+Begin
+ Write('Complex Set - Set element testing...');
+ op := ord(A_BKPT);
+ passed := true;
+ oplist:=[ord(A_MOVE)]+[ord(A_JSR)]-[op];
+ op2list:=[ord(A_MOVE)]+[ord(A_JSR)];
+ if oplist <> op2list then
+   passed := false;
+ oplist := [ord(A_MOVE)];
+ oplist := oplist - [ord(A_MOVE)];
+ if oplist <> [] then
+   passed := false;
+ oplist := oplist + [b];
+ if oplist <> [b] then
+   passed := false;
+ oplist := oplist - [b];
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+Procedure SetTestMulSets;
+{ FPC_SET_MUL_SETS }
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+ passed : boolean;
+Begin
+ passed := true;
+ Write('Set * Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[ord(A_MOVE)]+[ord(A_JSR)];
+ op2list:=[ord(A_MOVE)];
+ oplist:=oplist*op2list;
+ if oplist <> [ord(A_JSR)] then
+   passed := false;
+ oplist := [ord(A_MOVE),ord(A_FTST)];
+ op2list := [ord(A_MOVE),ord(A_FTST)];
+ oplist := oplist * op2list;
+ if oplist <> [ord(A_MOVE),ord(A_FTST)] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SetTestRange;
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+ passed : boolean;
+ op1 : tasmopint;
+ op2 : tasmopint;
+begin
+ passed := true;
+ Write('Range Set + element testing...');
+ op1 := ord(A_ADD);
+ op2 := ord(A_ASL);
+ oplist := [];
+ oplist := [op1..op2];
+ if oplist <> constset1[2] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SetTestByte;
+var
+ op2list :set of tasmopint;
+ oplist: set of tasmopint;
+ passed : boolean;
+ op1 : tasmopint;
+ op2 : tasmopint;
+ op : tasmopint;
+begin
+ Write('Simple Set + element testing...');
+ passed := true;
+ op := ord(A_LABEL);
+ oplist := [ord(A_MOVE),op,ord(A_JSR)];
+ if oplist <> [ord(A_MOVE),ord(A_LABEL),ord(A_JSR)] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+{------------------------------ TESTS FOR SMALL VALUES ---------------------}
+ procedure SmallSetTestEqual;
+  var
+    op2list :set of tsmallenumint;
+    oplist: set of tsmallenumint;
+    passed : boolean;
+  Begin
+   Write('Small Set == Small Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if not (constset3[2] = constset4[2]) then
+     passed := false;
+   if (constset3[1] = constset4[2]) then
+     passed := false;
+   if not (constset3[1] = [ord(DA),ord(DD),ord(DM)]) then
+     passed := false;
+ CheckPassed(passed);
+  end;
+
+ procedure SmallSetTestNotEqual;
+  var
+    op2list :set of tsmallenumint;
+    oplist: set of tsmallenumint;
+    passed : boolean;
+  Begin
+   Write('Small Set <> Small Set test...');
+   passed := true;
+   op2list:=[];
+   oplist:=[];
+   if not (oplist=op2list) then
+     passed := false;
+   if (constset3[2] <> constset4[2]) then
+     passed := false;
+   if not (constset3[1] <> constset4[2]) then
+     passed := false;
+{   if ( [ord(A_ADD)] <> [ord(A_ADD)] ) then optimized out.
+     passed := false;
+   if ( [ord(A_BLE)..ord(A_BPL)] <> [ord(A_BLE)..ord(A_BPL)] ) then
+     passed := false; }
+   if (constset3[1] <> [ord(DA),ord(DD),ord(DM)]) then
+     passed := false;
+ CheckPassed(passed);
+  end;
+
+  procedure SmallSetTestLt;
+  var
+    op2list :set of tsmallenumint;
+    oplist: set of tsmallenumint;
+    passed : boolean;
+   begin
+    Write('Small Set <= Small Set test...');
+    passed := true;
+    if constset3[1] <= constset4[2] then
+      passed := false;
+    oplist := [];
+    op2list := [ord(DC)];
+    if op2list <= oplist then
+     passed := false;
+    oplist := [ord(DC),ord(DF)..ord(DM)];
+    if oplist <= op2list then
+     passed := false;
+ CheckPassed(passed);
+   end;
+
+  Procedure SmallSetTestAddOne;
+    var
+     op : tsmallenumint;
+     oplist: set of tsmallenumint;
+  Begin
+    Write('Small Set + Small Set element testing...');
+    op:=ord(DG);
+    oplist:=[];
+    oplist:=oplist+[op];
+    CheckPassed( oplist = [ord(DG)] );
+  end;
+
+Procedure SmallSetTestAddTwo;
+var
+ op2list :set of tsmallenumint;
+ oplist: set of tsmallenumint;
+Begin
+ Write('Small Complex Set + Small Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[ord(DG)]+[ord(DI)];
+ op2list:=[ord(DM)];
+ oplist:=op2list+oplist;
+ CheckPassed( oplist = [ord(DG),ord(DI),ord(DM)] );
+end;
+
+
+Procedure SmallSetTestSubOne;
+var
+ op2list :set of tsmallenumint;
+ oplist: set of tsmallenumint;
+ op :tsmallenumint;
+ passed : boolean;
+Begin
+ Write('Small Set - Small Set element testing...');
+ passed := true;
+ op2list:=[];
+ oplist:=[];
+ op := ord(DL);
+ oplist:=[ord(DG)]+[ord(DI)]+[op];
+ op2list:=[ord(DG)]+[ord(DI)];
+ oplist:=oplist-op2list;
+ if oplist <> [ord(DL)] then
+   passed := false;
+
+ oplist:=[ord(DG)]+[ord(DI)]+[op];
+ op2list:=[ord(DG)]+[ord(DI)];
+ oplist:=op2list-oplist;
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+Procedure SmallSetTestSubTwo;
+const
+ b: tsmallenumint = (ord(DH));
+var
+ op2list :set of tsmallenumint;
+ oplist: set of tsmallenumint;
+ op : tsmallenumint;
+ passed : boolean;
+Begin
+ Write('Small Complex Set - Small Set element testing...');
+ op := ord(DL);
+ passed := true;
+ oplist:=[ord(DG)]+[ord(DI)]-[op];
+ op2list:=[ord(DG)]+[ord(DI)];
+ if oplist <> op2list then
+   passed := false;
+ oplist := [ord(DG)];
+ oplist := oplist - [ord(DG)];
+ if oplist <> [] then
+   passed := false;
+ oplist := oplist + [b];
+ if oplist <> [b] then
+   passed := false;
+ oplist := oplist - [b];
+ if oplist <> [] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+
+Procedure SmallSetTestMulSets;
+var
+ op2list : set of tsmallenumint;
+ oplist: set of tsmallenumint;
+ passed : boolean;
+Begin
+ passed := true;
+ Write('Small Set * Small Set element testing...');
+ op2list:=[];
+ oplist:=[];
+ oplist:=[ord(DG)]+[ord(DI)];
+ op2list:=[ord(DG)];
+ oplist:=oplist*op2list;
+ if oplist <> [ord(DI)] then
+   passed := false;
+ oplist := [ord(DG),ord(DK)];
+ op2list := [ord(DG),ord(DK)];
+ oplist := oplist * op2list;
+ if oplist <> [ord(DG),ord(DK)] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SmallSetTestRange;
+var
+ op2list :set of tsmallenumint;
+ oplist: set of tsmallenumint;
+ passed : boolean;
+ op1 : tsmallenumint;
+ op2 : tsmallenumint;
+begin
+ passed := true;
+ Write('Small Range Set + element testing...');
+ op1 := ord(DB);
+ op2 := ord(DI);
+ oplist := [];
+ oplist := [op1..op2];
+ if oplist <> constset3[2] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+procedure SmallSetTestByte;
+var
+ op2list : set of tsmallenumint;
+ oplist: set of tsmallenumint;
+ passed : boolean;
+ op1 : tsmallenumint;
+ op2 : tsmallenumint;
+ op : tsmallenumint;
+begin
+ Write('Small Simple Set + element testing...');
+ passed := true;
+ op := ord(DD);
+ oplist := [ord(DG),op,ord(DI)];
+ if oplist <> [ord(DG),ord(DD),ord(DI)] then
+   passed := false;
+ CheckPassed(passed);
+end;
+
+(*
+
+const
+ b: myenum = (ord(dA));
+var
+ enum: set of myenum;
+ oplist: set of tasmopint;
+ l : word;
+Begin
+  SetTestEqual;
+  SetTestNotEqual;
+{ small sets }
+ enum:=[];
+ { add }
+ enum:=enum+[ord(da)];
+ { subtract }
+ enum:=enum-[ord(da)];
+ if ord(DA) in enum then
+  WriteLn('Found ord(A_LABEL)');
+ { very large sets       }
+ { copy loop test        }
+ WRITELN('LARGE SETS:');
+ oplist := [ord(A_LABEL)];
+ { secondin test         }
+ if ord(A_LABEL) in oplist then
+  WriteLn('TESTING SIMPLE SECOND_IN: PASSED.');
+ { }
+ oplist:=[];
+ if ord(A_LABEL) in oplist then
+  WriteLn('SECOND IN FAILED.');
+{ SecondinSets;}
+ SetSetByte;
+ SetAddSets;
+ SetSubSets;
+ SetCompSets;
+ SetMulSets;
+ WRITELN('SMALL SETS:');
+ SmallInSets;
+ SmallAddSets;
+ SmallSubSets;
+ SmallCompSets;
+ SmallMulSets;
+ l:=word(ord(A_CPRESTORE));
+ if l = word(ord(A_CPRESTORE)) then
+  Begin
+  end;
+
+*)
+Begin
+  WriteLn('----------------------- Normal sets -----------------------');
+  { Normal sets }
+  SetTestEqual;
+  SetTestNotEqual;
+  SetTestAddOne;
+  SetTestAddTwo;
+  SetTestSubOne;
+  SetTestSubTwo;
+  SetTestRange;
+  SetTestLt;
+  SetTestByte;
+  { Small sets }
+  WriteLn('----------------------- Small sets -----------------------');
+  SmallSetTestEqual;
+  SmallSetTestNotEqual;
+  SmallSetTestAddOne;
+  SmallSetTestAddTwo;
+  SmallSetTestSubOne;
+  SmallSetTestSubTwo;
+  SmallSetTestRange;
+  SmallSetTestLt;
+  SmallSetTestByte;
+
+  if Err then
+   Halt(1);
+end.

tests/test/jvm/tarray2.pp

@@ -0,0 +1,124 @@
+{$mode objfpc}
+Program tarray2;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.print}
+
+{$else}
+uses
+  SysUtils;
+{$endif}
+
+{ Program to test array of const }
+
+{ All elements of the following record must be tested :
+  Elements not yet tested are commented out.
+
+    Type
+       PVarRec = ^TVarRec;
+       TVarRec = record
+         case vType: Byte of
+           vtInteger    : (VInteger: Integer; VType:Longint);
+           vtBoolean    : (VBoolean: Boolean);
+           vtChar       : (VChar: Char);
+           vtExtended   : (VExtended: PExtended);
+           vtString     : (VString: PShortString);
+           vtPointer    : (VPointer: Pointer);
+           vtPChar      : (VPChar: PChar);
+           vtObject     : (VObject: TObject);
+           vtClass      : (VClass: TClass);
+           // vtWideChar   : (VWideChar: WideChar);
+           // vtPWideChar  : (VPWideChar: PWideChar);
+           vtAnsiString : (VAnsiString: Pointer);
+           // vtCurrency   : (VCurrency: PCurrency);
+           // vtVariant    : (VVariant: PVariant);
+           // vtInterface  : (VInterface: Pointer);
+           // vtWideString : (VWideString: Pointer);
+           vtInt64      : (VInt64: PInt64);
+           vtQWord      : (VQWord: PQWord);
+       end;
+}
+
+procedure testit2 (args: array of byte);
+begin
+end;
+
+Procedure Testit (Args: Array of const);
+
+Var I : longint;
+
+begin
+  If High(Args)<0 then
+    begin
+    Writeln ('No aguments');
+    exit;
+    end;
+  Write ('Got '); Write (High(Args)+1); Writeln(' arguments :');
+  For i:=0 to High(Args) do
+    begin
+    write ('Argument '); write(i); write(' has type ');
+    case Args[i].vtype of
+      vtinteger    : begin Write ('Integer, Value :'); Writeln(args[i].vinteger); end;
+      vtboolean    : begin Write ('Boolean, Value :'); Writeln(args[i].vboolean); end;
+      vtchar       : begin Write ('Char, value : '); Writeln(args[i].vchar); end;
+      vtextended   : begin Write ('Extended, value : '); Writeln(args[i].VExtended^); end;
+      vtString     : begin Write ('ShortString, value :'); Writeln(unicodestring(args[i].VString^)); end;
+      vtPointer    : begin Write ('Pointer, toString : '); if assigned(Args[i].VPointer) then Writeln(JLString(JLObject(Args[i].VPointer).toString)) else writeln('nil') end;
+      vtPChar      : begin Write ('PCHar, value : '); Writeln(unicodestring(Ansistring(Args[i].VPChar))); end;
+      vtObject     : begin Write ('Object, toString : '); if assigned(Args[i].VObject) then Writeln(JLString(Args[i].VObject.toString)) else writeln('nil') end;
+      vtClass      : begin Write ('Class reference, toString : '); Writeln(JLString(JLClass(Args[i].VClass).toString)); end;
+      vtAnsiString : begin Write ('AnsiString, value :'); Writeln(unicodestring(AnsiString(Args[I].VAnsiString))); end;
+
+{
+      vtWideChar   : (VWideChar: WideChar);
+      vtPWideChar  : (VPWideChar: PWideChar);
+      vtCurrency   : (VCurrency: PCurrency);
+      vtVariant    : (VVariant: PVariant);
+      vtInterface  : (VInterface: Pointer);
+      vtWideString : (VWideString: Pointer);
+}
+      vtInt64      : begin Write ('Int64, value : '); Writeln(args[i].VInt64^); end;
+      vtQWord      : begin Write ('QWord, value : '); Writeln(int64(args[i].VQWord^)); end;
+    else
+      begin Write ('(Unknown) : '); Writeln(args[i].vtype); end;
+    end;
+    end;
+end;
+
+Const P1 : Pchar = 'Eerste Pchar';
+      p2 : Pchar = 'Tweede pchar';
+
+Var ObjA,ObjB : TObject;
+    ACLass,BClass : TClass;
+    S,T : AnsiString;
+
+begin
+  ObjA:=TObject.Create;
+  ObjB:=TObject.Create;
+  AClass:=TObject;
+  S:='Ansistring 1';
+  T:='AnsiString 2';
+  Write ('Size of VarRec : '); Writeln(Sizeof(TVarRec));
+  Testit ([]);
+  Testit ([1,2]);
+  Testit (['A','B']);
+  Testit ([TRUE,FALSE,TRUE]);
+  Testit (['String','Another string']);
+  Testit ([S,T])  ;
+  Testit ([P1,P2]);
+  Testit ([@testit,Nil]);
+  Testit ([ObjA,ObjB]);
+  Testit ([1.234,1.234]);
+  TestIt ([AClass]);
+  TestIt ([QWord(1234)]);
+  TestIt ([Int64(1234)]);
+  TestIt ([Int64(12341234)*1000000000+Int64(12341234)]);
+
+  TestIt2 ([]);
+  TestIt2 ([1,2]);
+end.

tests/test/jvm/tarray3.pp

@@ -0,0 +1,185 @@
+program tarray3;
+
+{$modeswitch exceptions}
+
+uses
+  jdk15;
+  
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+
+{$j+}
+{$P+}
+
+type
+   CharA4 = array [1..4] of char;
+   CharA6 = array [1..6] of char;
+   String4 = String[4];
+   String5 = String[5];
+   String6 = String[6];
+   String8 = String[8];
+
+const
+   car4_1 : CharA4 = 'ABCD';
+   car4_2 : CharA4 = 'abcd';
+   car6_1 : CharA6 = 'EFGHIJ';
+   car6_2 : CharA6 = 'efghij';
+   cst4_1 : String4 = 'ABCD';
+   cst6_2 : string6 = 'EFGHIJ';
+   cst8_1 : string8 = 'abcd';
+   cst8_2 : string8 = 'efghij';
+
+var
+  ar4_1, ar4_2 : CharA4;
+  ar6_1, ar6_2 : CharA6;
+  st4_1, st4_2 : string4;
+  st5_1, st5_2 : string5;
+  st6_1, st6_2 : string6;
+  st8_1, st8_2 : string8;
+
+const
+  has_errors : boolean = false;
+
+  procedure error(const st : string);
+    begin
+      writeln(unicodestring('Error: '+st));
+      has_errors:=true;
+    end;
+
+  procedure testvalueconv(st : string4);
+  begin
+    writeln(unicodestring('st='+st));
+    Write('Length(st)=');writeln(Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling value arg');
+  end;
+
+  procedure testconstconv(const st : string4);
+  begin
+    writeln(unicodestring('st='+st));
+    Write('Length(st)=');writeln(Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling const arg');
+  end;
+
+  procedure testvarconv(var st : string4);
+  begin
+    writeln(unicodestring('st='+st));
+    Write('Length(st)=');writeln(Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling var arg');
+  end;
+
+{ is global switch+ can't turn off here }
+{P-}
+  procedure testvarconv2(var st : string4);
+  begin
+    writeln(unicodestring('st='+st));
+    Write('Length(st)=');writeln(Length(st));
+    If Length(st)>4 then
+      Error('string length too big in calling var arg without openstring');
+  end;
+
+begin
+  { compare array of char to constant strings }
+  writeln(unicodestring('Testing if "'+car4_1+'" is equal to "'+cst4_1+'"'));
+  if car4_1<>cst4_1 then
+    error('Comparison of array of char and string don''t work');
+  writeln(unicodestring('Testing if "'+car4_1+'" is equal to "ABCD"'));
+  if car4_1<>'ABCD' then
+    error('Comparison of array of char and constat string don''t work');
+  writeln(unicodestring('Testing if "'+cst4_1+'" is equal to "ABCD"'));
+  if 'ABCD'<>cst4_1 then
+    error('Comparison of string and constant string don''t work');
+  car4_1:='AB'#0'D';
+  if car4_1='AB' then
+    writeln('Anything beyond a #0 is ignored')
+  else if car4_1='AB'#0'D' then
+    Writeln('Chars after #0 are not ignored')
+  else
+    Error('problems if #0 in array of char');
+{$ifdef FPC this is not allowed in BP !}
+  car4_1:=cst4_1;
+{ if it is allowed then it must also work correctly !! }
+  writeln(unicodestring('Testing if "'+car4_1+'" is equal to "'+cst4_1+'"'));
+  if car4_1<>cst4_1 then
+    error('Comparison of array of char and string don''t work');
+{$ifdef test_known_problems}
+  if string4(car6_2)<>'efgh' then
+    error('typcasting to shorter strings leads to problems');
+{$endif}
+  ar4_2:='Test';
+  ar4_1:=cst6_2;
+  if ar4_2<>'Test' then
+    error('overwriting beyond char array size');
+  ar6_1:='Test'#0'T';
+  st6_1:=ar6_1;
+  if (st6_1<>ar6_1) or (st6_1='Test') then
+    error('problems with #0');
+  ar6_1:='AB';
+  if ar6_1='AB'#0't'#0'T' then
+    Error('assigning strings to array of char does not zero end of array if string is shorter');
+  if ar6_1='AB'#0#0#0#0 then
+    writeln('assigning shorter strings to array of char does zero rest of array')
+  else
+    error('assigning "AB" to ar6_1 gives '+ar6_1);
+{$endif}
+  cst8_1:=car4_1;
+{ if it is allowed then it must also work correctly !! }
+  writeln(unicodestring('Testing if "'+car4_1+'" is equal to "'+cst8_1+'"'));
+  if car4_1<>cst8_1 then
+    error('Comparison of array of char and string don''t work');
+  st4_2:='Test';
+  st4_1:=car6_1;
+  if (st4_2<>'Test') or (st4_1<>'EFGH') then
+    error('problems when copying long char array to shorter string');
+  testvalueconv('AB');
+  testvalueconv('ABCDEFG');
+  testvalueconv(car4_1);
+  testvalueconv(car6_1);
+(*  
+  getmem(pc+256);
+  pc:='Long Test';
+{$ifdef FPC this is not allowed in BP !}
+  testvalueconv(pc);
+{$endif def FPC this is not allowed in BP !}
+*)
+  testconstconv('AB');
+{$ifdef test_known_problems}
+  testconstconv('ABCDEFG');
+{$endif}
+  testconstconv(st4_1);
+{$ifdef test_known_problems}
+  testconstconv(cst6_2);
+{$endif}
+{$ifdef FPC this is not allowed in BP !}
+(*
+{$ifdef test_known_problems}
+  testconstconv(pc);
+{$endif}
+*)
+{$endif def FPC this is not allowed in BP !}
+  testvarconv(st4_2);
+  testvarconv(cst4_1);
+{$ifdef FPC this is not allowed in BP !}
+{$ifdef test_known_problems}
+  testvarconv(st6_1);
+  testvarconv(cst8_1);
+{$endif}
+{$endif def FPC this is not allowed in BP !}
+  { testvarconv(pc); this one fails at compilation }
+  testvarconv2(st4_2);
+  testvarconv2(cst4_1);
+{$ifdef FPC this is not allowed in BP !}
+{$ifdef test_known_problems}
+  testvarconv2(st6_1);
+  testvarconv2(cst8_1);
+{$endif}
+{$endif def FPC this is not allowed in BP !}
+  if has_errors then
+    begin
+      writeln(unicodestring('There are still problems with arrays of char'));
+      raise JLException.Create;
+    end;
+end.

tests/test/jvm/tbyte.pp

@@ -0,0 +1,19 @@
+program tbyte;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+function test: longint;
+var
+ a : longword;
+begin
+ a := 123456789;
+ result := JLInteger.Create(Byte(a)).intValue;
+end;
+
+begin
+  if test<>21 then
+    raise JLException.create('boe!');
+end.

tests/test/jvm/tbytearrres.pp

@@ -0,0 +1,37 @@
+program tbytearrres;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  ByteArray = array of byte;
+
+function GetUInt32(Src: array of byte; Offset : integer) : cardinal;
+begin
+  result:=src[offset];
+end;
+
+function JByteArrayToByteArray(A : Arr1jbyte; Start: integer = 0; Count : integer = -1) : ByteArray;
+var
+  i: longint;
+begin
+  if count=-1 then
+    count:=length(a);
+  setlength(result,count);
+  for i:=start to start+count-1 do
+    result[i-start]:=a[i];
+end;
+
+function AddressToInt(X : JNInetAddress) : Cardinal;
+begin
+ result := GetUInt32(JByteArrayToByteArray(X.getAddress()), 0);
+end;
+
+var
+  c: cardinal;
+begin
+  c:=AddressToInt(JNInetAddress.getLocalHost);
+  JLSystem.fout.println(int64(c));
+end.

tests/test/jvm/tclassproptest.pp

@@ -0,0 +1,32 @@
+program tclassproptest;
+
+{$mode objfpc}
+
+uses
+  jdk15;
+
+type
+  tclassprop = class
+   strict private
+    class var fx: longint;
+   public
+    class property x: longint read fx write fx;
+    class procedure test(l: longint);
+  end;
+
+class procedure tclassprop.test(l: longint);
+  begin
+    if fx<>l then
+      raise jlexception.create('test 1 error');
+  end;
+
+
+var
+  c: tclassprop;
+begin
+  c:=tclassprop.create;
+  c.x:=123;
+  c.test(123);
+  if c.x<>123 then
+    raise jlexception.create('test 2 error');
+end.

tests/test/jvm/tcnvstr1.pp

@@ -0,0 +1,619 @@
+program tcnvstr1;
+
+{****************************************************************}
+{  CODE GENERATOR TEST PROGRAM                                   }
+{  Copyright (c) 2002, Carl Eric Codere                          }
+{****************************************************************}
+{ NODE TESTED : secondtypeconvert() -> second_string_string      }
+{****************************************************************}
+{ PRE-REQUISITES: secondload()                                   }
+{                 secondassign()                                 }
+{                 secondtypeconv()                               }
+{****************************************************************}
+{ DEFINES:                                                       }
+{            FPC     = Target is FreePascal compiler             }
+{****************************************************************}
+{ REMARKS: Same type short conversion is not tested, except for  }
+{          shortstrings , since it requires special handling.    }
+{                                                                }
+{                                                                }
+{****************************************************************}
+
+{$ifdef fpc}
+{$mode objfpc}
+  {$ifndef ver1_0}
+    {$define haswidestring}
+  {$endif}
+{$else}
+  {$ifndef ver70}
+    {$define haswidestring}
+  {$endif}
+{$endif}
+
+{$define hasshortstring}
+
+uses
+  jdk15;
+{$H+}
+
+{$macro on}
+{$define writeln:=JLSystem.fout.println}
+{$define write:=JLSystem.fout.print}
+
+const
+  { exactly 255 characters in length }
+  BIG_STRING =
+' This is a small text documentation to verify the validity of'+
+' the string conversion routines. Of course the conversion routines'+
+' should normally work like a charm, and this can only test that there'+
+' aren''t any problems with maximum length strings. This fix!';
+  { < 255 characters in length }
+  SMALL_STRING = 'This is a small hello!';
+  { > 255 characters in length }
+  HUGE_STRING_END = ' the goal of this experiment';
+  HUGE_STRING =
+' This is a huge text documentation to verify the validity of'+
+' the string conversion routines. Of course the conversion routines'+
+' should normally work like a charm, and this can only test that there'+
+' aren''t any problems with maximum length strings. I hope you understand'+
+HUGE_STRING_END;
+  EMPTY_STRING = '';
+
+type
+  shortstr = string[127];
+var
+{$ifdef hasshortstring}
+ s2: shortstr;
+{$endif}
+ str_ansi: ansistring;
+{$ifdef hasshortstring}
+ str_short: shortstring;
+{$endif}
+{$ifdef haswidestring}
+ str_wide : widestring;
+{$endif}
+
+
+procedure fail;
+ begin
+   Raise JLException.create('failure');
+ end;
+
+{$ifdef hasshortstring}
+procedure test_ansi_to_short;
+var
+  p: pchar;
+begin
+ {************************************************************************}
+ {                          ansistring -> shortstring                     }
+ {************************************************************************}
+ WriteLn('Test ansistring -> shortstring');
+ { ansistring -> shortstring }
+ str_short := '';
+ str_ansi:='';
+ str_ansi := SMALL_STRING;
+ str_short:=str_ansi;
+ Write('small ansistring -> shortstring...');
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ str_short := '';
+ str_ansi:='';
+ str_ansi := EMPTY_STRING;
+ str_short:=str_ansi;
+ Write('empty ansistring -> shortstring...');
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+
+ str_short := '';
+ str_ansi:='';
+ str_ansi := BIG_STRING;
+ str_short:=str_ansi;
+ Write('big ansistring -> shortstring...');
+ jlsystem.fout.println;
+ jlsystem.fout.println('const: '+BIG_STRING);
+ jlsystem.fout.println('ansi : '+unicodestring(str_ansi));
+ jlsystem.fout.println('short: '+unicodestring(str_short));
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+
+ Write('huge ansistring -> shortstring...');
+ str_short := '';
+ str_ansi:='';
+ str_ansi := HUGE_STRING;
+ str_short:=str_ansi;
+ { Delphi 3/Delphi 6 does not consider these as the same string }
+ if str_short <> str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+{}
+ s2 := '';
+ str_ansi:='';
+ str_ansi := SMALL_STRING;
+ s2:=str_ansi;
+ Write('small ansistring -> shortstring...');
+ if s2 = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ s2 := '';
+ str_ansi:='';
+ str_ansi := EMPTY_STRING;
+ s2:=str_ansi;
+ Write('empty ansistring -> shortstring...');
+ if s2 = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+  str_ansi:='';
+  p:=pchar(str_ansi);
+  Write('empty ansistring -> pchar...');
+  if p^<>#0 then
+    fail;
+  if p[0]<>#0 then
+    fail
+  else
+    Writeln('Success');
+
+ s2 := '';
+ str_ansi:='';
+ str_ansi := BIG_STRING;
+ s2:=str_ansi;
+ Write('big ansistring -> shortstring...');
+ { Should fail, since comparing different string lengths }
+ if s2 <> str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+
+ str_ansi := BIG_STRING;
+ Write('big ansistring -> pchar...');
+ p:=pchar(str_ansi);
+ if p^<>' ' then
+   fail;
+ if p[0]<>' ' then
+   fail;
+ if length(p)<>length(BIG_STRING) then
+   fail
+ else
+   Writeln('Success');
+
+
+ s2 := '';
+ str_ansi:='';
+ str_ansi := HUGE_STRING;
+ s2:=str_ansi;
+ Write('huge ansistring -> shortstring...');
+ { Should fail, since comparing different string lengths }
+ if s2 <> str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+end;
+
+
+procedure test_short_to_short;
+begin
+ {************************************************************************}
+ {                         shortstring -> shortstring                     }
+ {************************************************************************}
+ WriteLn('Test shortstring -> shortstring...');
+ { shortstring -> shortstring }
+ str_short := '';
+ s2:='';
+ s2 := SMALL_STRING;
+ str_short:=s2;
+ Write('small shortstring -> shortstring...');
+ if str_short = s2 then
+   WriteLn('Success.')
+ else
+   fail;
+
+ str_short := '';
+ s2:='';
+ s2 := EMPTY_STRING;
+ str_short:=s2;
+ Write('empty shortstring -> shortstring...');
+ if str_short = s2 then
+   WriteLn('Success.')
+ else
+   fail;
+
+{$ifdef fpc}
+{ Delphi does not compile these }
+ str_short := '';
+ s2:='';
+ s2 := BIG_STRING;
+ str_short:=s2;
+ Write('big shortstring -> shortstring...');
+ if str_short = s2 then
+   WriteLn('Success.')
+ else
+   fail;
+
+
+ str_short := '';
+ s2:='';
+ s2 := HUGE_STRING;
+ str_short:=s2;
+ Write('huge shortstring -> shortstring...');
+ { Delphi 3/Delphi 6 does not consider these as the same string }
+ if str_short = s2 then
+   WriteLn('Success.')
+ else
+   fail;
+{$endif}
+
+ s2 := '';
+ str_short:='';
+ str_short := SMALL_STRING;
+ Write('small shortstring -> shortstring...');
+ s2:=str_short;
+ if s2 = str_short then
+   WriteLn('Success.')
+ else
+   fail;
+
+ s2 := '';
+ str_short:='';
+ str_short := EMPTY_STRING;
+ Write('empty shortstring -> shortstring...');
+ s2:=str_short;
+ if s2 = str_short then
+   WriteLn('Success.')
+ else
+   fail;
+
+ s2 := '';
+ str_short:='';
+ str_short := BIG_STRING;
+ Write('big shortstring -> shortstring...');
+ s2:=str_short;
+ { Should fail, since comparing different string lengths }
+ if s2 <> str_short then
+   WriteLn('Success.')
+ else
+   fail;
+
+{$ifdef fpc}
+ s2 := '';
+ str_short:='';
+ writeln(length(ShortstringClass(@str_short).fdata));
+ writeln(length(str_short));
+ str_short := HUGE_STRING;
+ writeln(length(ShortstringClass(@str_short).fdata));
+ writeln(length(str_short));
+ Write('huge shortstring -> shortstring...');
+ s2:=str_short;
+ writeln(unicodestring(s2));
+ writeln(unicodestring(str_short));
+ { Should fail, since comparing different string lengths }
+ if s2 <> str_short then
+   WriteLn('Success.')
+ else
+   fail;
+{$endif}
+end;
+
+
+procedure test_short_to_ansi;
+begin
+ {************************************************************************}
+ {                         shortstring -> ansistring                      }
+ {************************************************************************}
+ WriteLn('Test shortstring -> ansistring');
+ Write('small shortstring -> ansistring...');
+ { shortstring -> ansistring }
+ str_short := SMALL_STRING;
+ str_ansi:=str_short;
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty shortstring -> ansistring...');
+ str_short := EMPTY_STRING;
+ str_ansi:=str_short;
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('big shortstring -> ansistring...');
+ str_short := BIG_STRING;
+ str_ansi:=str_short;
+ if str_short = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('small shortstring -> ansistring...');
+ { shortstring -> ansistring }
+ s2 := SMALL_STRING;
+ str_ansi:=s2;
+ if s2 = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty shortstring -> ansistring...');
+ s2 := EMPTY_STRING;
+ str_ansi:=s2;
+ if s2 = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+end;
+{$endif}
+
+{$ifdef haswidestring}
+procedure test_wide_to_ansi;
+begin
+ {************************************************************************}
+ {                         widestring -> ansistring                      }
+ {************************************************************************}
+ WriteLn('Test widestring -> ansistring');
+ Write('small widestring -> ansistring...');
+ { widestring -> ansistring }
+ str_wide := SMALL_STRING;
+ str_ansi:=str_wide;
+ if str_wide = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty widestring -> ansistring...');
+ str_wide := EMPTY_STRING;
+ str_ansi:=str_wide;
+ if str_wide = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('big widestring -> ansistring...');
+ str_wide := BIG_STRING;
+ str_ansi:=str_wide;
+ if str_wide = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('huge widestring -> ansistring...');
+ str_wide := HUGE_STRING;
+ str_ansi:=str_wide;
+ if str_wide = str_ansi then
+   WriteLn('Success.')
+ else
+   fail;
+
+end;
+
+
+{$ifdef hasshortstring}
+procedure test_short_to_wide;
+begin
+ {************************************************************************}
+ {                         shortstring -> widestring                      }
+ {************************************************************************}
+ WriteLn('Test shortstring -> widestring');
+ Write('small shortstring -> widestring...');
+ { shortstring -> widestring }
+ str_short := SMALL_STRING;
+ str_wide:=str_short;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty shortstring -> widestring...');
+ str_short := EMPTY_STRING;
+ str_wide:=str_short;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('big shortstring -> widestring...');
+ str_short := BIG_STRING;
+ str_wide:=str_short;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+{$ifdef hasshortstring}
+ Write('small shortstring -> widestring...');
+ { shortstring -> widestring }
+ s2 := SMALL_STRING;
+ str_wide:=s2;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty shortstring -> widestring...');
+ s2 := EMPTY_STRING;
+ str_wide:=s2;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+{$endif}
+end;
+{$endif}
+
+procedure test_ansi_to_wide;
+begin
+ {************************************************************************}
+ {                         ansistring -> widestring                      }
+ {************************************************************************}
+ WriteLn('Test ansistring -> widestring');
+ Write('small ansistring -> widestring...');
+ { ansistring -> widestring }
+ str_ansi := SMALL_STRING;
+ str_wide:=str_ansi;
+ if str_ansi = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty ansistring -> widestring...');
+ str_ansi := EMPTY_STRING;
+ str_wide:=str_ansi;
+ if str_ansi = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('big ansistring -> widestring...');
+ str_ansi := BIG_STRING;
+ str_wide:=str_ansi;
+ if str_ansi = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+{$ifdef hasshortstring}
+ Write('small ansistring -> widestring...');
+ { ansistring -> widestring }
+ s2 := SMALL_STRING;
+ str_wide:=s2;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty ansistring -> widestring...');
+ s2 := EMPTY_STRING;
+ str_wide:=s2;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+{$endif hasshortstring}
+
+end;
+
+
+{$ifdef hasshortstring}
+procedure test_wide_to_short;
+begin
+ {************************************************************************}
+ {                          widestring -> shortstring                     }
+ {************************************************************************}
+ WriteLn('Test widestring -> shortstring');
+ { widestring -> shortstring }
+ str_short := '';
+ str_wide:='';
+ str_wide := SMALL_STRING;
+ Write('small widestring -> shortstring...');
+ str_short:=str_wide;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ str_short := '';
+ str_wide:='';
+ str_wide := EMPTY_STRING;
+ Write('empty widestring -> shortstring...');
+ str_short:=str_wide;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+
+ Write('big widestring -> shortstring...');
+ str_short := '';
+ str_wide:='';
+ str_wide := BIG_STRING;
+ str_short:=str_wide;
+ if str_short = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('huge widestring -> shortstring...');
+ str_wide := HUGE_STRING;
+ str_short:=str_wide;
+ if str_short <> str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+{}
+ Write('small widestring -> shortstring...');
+ s2 := '';
+ str_wide:='';
+ str_wide := SMALL_STRING;
+ s2:=str_wide;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('empty widestring -> shortstring...');
+ s2 := '';
+ str_wide:='';
+ str_wide := EMPTY_STRING;
+ s2:=str_wide;
+ if s2 = str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('big widestring -> shortstring...');
+ s2 := '';
+ str_wide:='';
+ str_wide := BIG_STRING;
+ s2:=str_wide;
+ if s2 <> str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+
+ Write('huge widestring -> shortstring...');
+ s2 := '';
+ str_wide:='';
+ str_wide := HUGE_STRING;
+ s2:=str_wide;
+ if s2 <> str_wide then
+   WriteLn('Success.')
+ else
+   fail;
+end;
+{$endif}
+{$endif}
+
+Begin
+{$ifdef hasshortstring}
+ test_ansi_to_short;
+ test_short_to_short;
+ test_short_to_ansi;
+{$endif}
+ { requires widestring support }
+{$ifdef haswidestring}
+{$ifdef hasshortstring}
+ test_short_to_wide;
+{$endif}
+ test_ansi_to_wide;
+{$ifdef hasshortstring}
+ test_wide_to_short;
+{$endif}
+ test_wide_to_ansi;
+{$endif}
+End.

tests/test/jvm/tcnvstr3.pp

@@ -0,0 +1,156 @@
+program tcnvstr3;
+
+{ Type conversion program for char -> string     }
+{ possible types widechar -> widestring          }
+{                widechar -> shortstring         }
+{                widechar -> ansistring          }
+{ possible types char     -> widestring          }
+{                char     -> shortstring         }
+{                char     -> ansistring          }
+
+{$ifdef fpc}
+{$mode objfpc}
+  {$ifndef ver1_0}
+    {$define haswidestring}
+  {$endif}
+{$else}
+  {$ifndef ver70}
+    {$define haswidestring}
+  {$endif}
+{$endif}
+
+uses jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+
+procedure fail;
+ begin
+   WriteLn('Failure!');
+   raise JLException.Create;
+ end;
+
+var
+ str_ansi : ansistring;
+ str_short : shortstring;
+{$ifdef haswidestring}
+ str_wide : widestring;
+ wc : widechar;
+{$endif haswidestring}
+ c: char;
+ _result : boolean;
+Begin
+ {********************** char/widechar -> shortstring *******************}
+ Write('widechar/char -> shortstring...');
+ {* normal char *}
+ _result := true;
+ { empty string -> shortstring  }
+ str_short := '';
+ if str_short <> '' then
+   _result := false;
+ { constant char -> shortstring }
+ str_short := 'c';
+ if str_short <> 'c' then
+   _result := false;
+ { normal char   -> shortstring }
+ str_short := '';
+ c:='c';
+ str_short:=c;
+ if str_short <> 'c' then
+   _result := false;
+ {* wide char *}
+{$ifdef haswidestring}
+ { constant char -> shortstring }
+ str_short := shortstring(widechar('c'));
+ if str_short <> 'c' then
+   _result := false;
+{$endif}
+ { wide char   -> shortstring }
+{ This should not compile - at least it does not compile under Delphi }
+{ str_short := '';
+ wc:='c';
+ str_short:=wc;
+ if str_short <> 'c' then
+   _result := false;}
+
+
+ if _result then
+   WriteLn('Success!')
+ else
+   fail;
+ {********************** char/widechar -> ansistring *******************}
+ Write('widechar/char -> ansistring...');
+ {* normal char *}
+ _result := true;
+ { empty string -> ansistring  }
+ str_ansi := '';
+ if str_ansi <> '' then
+   _result := false;
+ { constant char -> ansistring }
+ str_ansi := 'c';
+ if str_ansi <> 'c' then
+   _result := false;
+ { normal char   -> ansistring }
+ str_ansi := '';
+ c:='c';
+ str_ansi:=c;
+ if str_ansi <> 'c' then
+   _result := false;
+ {* wide char *}
+{$ifdef haswidestring}
+ { constant char -> ansistring }
+ str_ansi := widechar('c');
+ if str_ansi <> 'c' then
+   _result := false;
+ { normal char   -> ansistring }
+ str_ansi := '';
+ wc:='c';
+ str_ansi:=wc;
+ if str_ansi <> 'c' then
+   _result := false;
+{$endif}
+
+ if _result then
+   WriteLn('Success!')
+ else
+   fail;
+{}
+{$ifdef haswidestring}
+ {********************** char/widechar -> widestring *******************}
+ Write('widechar/char -> widestring...');
+ {* normal char *}
+ _result := true;
+ { empty string -> widestring  }
+ str_wide := '';
+ if str_wide <> '' then
+   _result := false;
+ { constant char -> widestring }
+ str_wide := 'c';
+ if str_wide <> 'c' then
+   _result := false;
+ { normal char   -> widestring }
+ str_wide := '';
+ c:='c';
+ str_wide:=c;
+ if str_wide <> 'c' then
+   _result := false;
+ {* wide char *}
+ { constant char -> widestring }
+ str_wide := widechar('c');
+ if str_wide <> 'c' then
+   _result := false;
+ { normal char   -> widestring }
+ str_wide := '';
+ wc:='c';
+ str_wide:=wc;
+ if str_wide <> 'c' then
+   _result := false;
+
+
+ if _result then
+   WriteLn('Success!')
+ else
+   fail;
+{$endif haswidestring}
+end.

tests/test/jvm/tconst.pp

@@ -0,0 +1,40 @@
+program tconst;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  tc = class
+    const x: longint = 5;
+  end;
+
+  ttypedconstrec = record
+    l: longint;
+  end;
+
+procedure test; overload;
+const
+  l: longint = 1;
+  r: ttypedconstrec = (l: 5);
+begin
+  if r.l<>5 then
+    raise jlexception.create('test1 r.l');
+  if l<>1 then
+    raise jlexception.create('test1 l');
+end;
+
+procedure test(x: byte); overload;
+const
+  { check that it gets a different mangled name }
+  l: longint = 4;
+begin
+  if l<>4 then
+    raise jlexception.create('test1 l');
+end;
+
+begin
+  test;
+  test(3);
+end.

tests/test/jvm/tdefpara.pp

@@ -0,0 +1,34 @@
+program tdefpara;
+
+{$mode delphi}
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$endif}
+
+
+type
+  tc = class
+    fa: longint;
+    constructor create(a: longint = 1234);
+  end;
+
+  tc2 = class(tc)
+  end;
+
+constructor tc.create(a: longint = 1234);
+begin
+  fa:=a;
+end;
+
+var
+  c: tc;
+begin
+  c:=tc2.create;
+  if c.fa<>1234 then
+    raise jlexception.create('wrong overload');
+end.

tests/test/jvm/tdynarrec.pp

@@ -0,0 +1,48 @@
+Program tdynarrec;
+
+{$mode objfpc}
+
+uses
+  jdk15;
+
+type
+  tdynrec = record
+    s: string[10];
+  end;
+
+
+procedure error(l: longint);
+begin
+  JLSystem.fout.print('error: ');
+  JLSystem.fout.println(l);
+  raise jlexception.create('fatal');
+end;
+
+var
+  r1,r2: array of tdynrec;
+  rr: tdynrec;
+begin
+  setlength(r1,5);
+  r2:=r1;
+  rr.s:='abc';
+  r1[0]:=rr;
+  if r2[0].s<>'abc' then
+    error(0);
+  rr.s:='def';
+  if r1[0].s<>'abc' then
+    error(1);
+  r1[1]:=rr;
+  if r1[0].s<>'abc' then
+    error(2);
+  setlength(r2,6);
+  if r1[0].s<>'abc' then
+    error(3);
+  if r2[0].s<>'abc' then
+    error(4);
+  if r2[1].s<>'def' then
+    error(3);
+  rr.s:='ghi';
+  r1[0]:=rr;
+  if r2[0].s<>'abc' then
+    error(5);
+end.

tests/test/jvm/tenum.pp

@@ -0,0 +1,84 @@
+program tenum;
+
+{$mode delphi}
+
+uses
+  uenum;
+
+const
+  cenum = mea;
+
+type
+  tenumclass = class
+    e: myenum;
+    constructor create;
+  end;
+
+constructor tenumclass.create;
+  begin
+    if e<>mea then
+      raise JLException.create('error create');
+  end;
+
+function func: myenum;
+begin
+  result:=cenum;
+end;
+
+var
+  a: myenum;
+  b1,b2: myenumjumps;
+  l: longint;
+  arr: array[myenum] of byte;
+  c: tenumclass;
+  earr: array[1..4] of myenum;
+  dearr: array of myenum;
+begin
+  c:=tenumclass.create;
+  if earr[1]<>mea then
+    raise JLException.create('error 0');
+  setlength(dearr,1);
+  if dearr[0]<>mea then
+    raise JLException.create('error 0a');
+  a:=cenum;
+  inc(a);
+  if ord(a)<>1 then
+    raise JLException.create('error 1');
+  a:=succ(a);
+  if a<>mec then
+    raise JLException.create('error 2');
+
+  arr[a]:=123;
+  if arr[mec]<>123 then
+    raise JLException.create('error 2a');
+  l:=0;
+  for a:=func to mec do
+    inc(l,ord(a));
+  if l<>3 then
+    raise JLException.create('error 2b');
+  if JLObject(mea).toString<>'mea' then
+    raise JLException.create('expected mea, got '+unicodestring(JLObject(mea).toString));
+
+  a:=mec;
+  case a of
+    mea..meb:
+     raise JLException.create('error 2c');
+    mec:
+      ;
+    else
+     raise JLException.create('error 2d');
+  end;
+   
+
+  b1:=meja;
+  b2:=mejb;
+  if b1<=b2 then
+    raise JLException.create('error 3');
+  b2:=mejc;
+  if b1>=b2 then
+    raise JLException.create('error 4');
+  l:=-5;
+  b2:=myenumjumps(l);
+  if b2<>mejb then
+    raise JLException.create('error 5');
+end.

tests/test/jvm/test.pp

@@ -0,0 +1,2164 @@
+{$mode delphi}
+{$codepage utf-8}
+
+{$namespace org.freepascal.test}
+
+{$j-}
+
+Unit test;
+
+interface
+
+const
+  unitintconst = 3;
+  unitfloatconst = 2.0;
+  unitdoubleconst = 0.1;
+
+const
+  tcl: longint = 4;
+
+type
+  trec = record
+    a,b,c,d,e: longint;
+  end;
+  
+const
+  tcrec: trec = (a:1;b:2;c:3;d:4;e:5);
+
+type
+  TMyClass = class
+   const
+    classintconst = 4;
+    classfloatconst = 3.0;
+    classdoubleconst = 0.3;
+    classtcstringconst: unicodestring = 'abcdef';
+   class var
+    rec: trec;
+   var
+    intfield: jint;
+
+    staticbytefield: jbyte; static;
+
+    constructor create; overload;
+    constructor create(l: longint);overload;
+    constructor create(l1, l2: longint);overload;
+    function sub(a1, a2: longint): longint;
+    function test(l1, l2: longint): longint;
+    class function staticmul3(l: longint): longint; static;
+
+    procedure longboolobj(l: jlong; b: boolean; obj: tobject);
+
+    procedure setintfield(l: jint);
+    function getintfield: jint;
+    property propintfield: jint read getintfield write setintfield;
+    procedure setstaticbytefield(b: byte);
+    function getstaticbytefield: byte;
+
+    class procedure setstaticbytefieldstatic(b: byte); static;
+    class function getstaticbytefieldstatic: byte; static;
+
+    class procedure settestglobal(l: longint); static;
+    class function gettestglobal: longint; static;
+  end;
+
+  tisinterface = interface
+  end;
+  tisclassbase = class
+    procedure abstr; virtual; abstract;
+  end;
+  tisclassbase2 = class(tisclassbase)
+  end;
+  tisclass1 = class(tisclassbase2)
+    type
+      tisclass1nested = class(tisinterface)
+        var
+          anonrec: record c: char; end;
+        type
+          tisclass1nestedl2 = class
+            anonrec: record l: longint; end;
+            constructor create;
+            function testl2: jint;
+          end;
+        constructor create;
+        function testl1: jint;
+      end;
+    constructor create;
+    procedure abstr; override;
+  end;
+  
+  tisclass1ref = class of tisclass1;
+
+type
+  tnestrec = record
+    r: trec;
+    arr: array[3..4] of byte;
+  end;
+
+const
+  tcnestrec: tnestrec = (r:(a:1;b:2;c:3;d:4;e:5);arr:(7,6));
+
+var
+  anonrec: record s: string; end;
+
+function testset: jint;
+function testloop: longint;
+function testfloat: jint;
+function testcnvint1: longint;
+function testint2real: longint;
+function TestCmpListOneShort: longint;
+function TestCmpListTwoShort: longint;
+function TestCmpListOneWord: longint;
+function TestCmpListTwoWord: longint;
+function TestCmpListOneInt64: longint;
+function TestCmpListTwoInt64: longint;
+function TestCmpListThreeInt64: longint;
+function TestCmpListRangesOneShort: longint;
+function TestCmpListRangesTwoShort: longint;
+function TestCmpListRangesOneWord: longint;
+function TestCmpListRangesTwoWord: longint;
+function TestCmpListRangesThreeWord: longint;
+function TestCmpListRangesOneInt64: longint;
+function TestCmpListRangesTwoInt64: longint;
+function testsqr: longint;
+function testtrunc: longint;
+function testdynarr: longint;
+function testdynarr2: longint;
+function testbitcastintfloat: jint;
+function testis: longint;
+function testneg: longint;
+function testtry1: longint;
+function testtry2: longint;
+function testtryfinally1: longint;
+function testtryfinally2: longint;
+function testtryfinally3: longint;
+function testsmallarr1: longint;
+function testopenarr1: longint;
+function testopenarr2: longint;
+function testopenarr3: longint;
+function testopendynarr: longint;
+function testsmallarr2: longint;
+function testsmallarr3: longint;
+function testsmallarr4: longint;
+
+function testrec1: longint;
+function testopenarr1rec: longint;
+function testrec2: longint;
+
+
+function testunicodestring: JLString;
+function testunicodestring2: JLString;
+function testunicodestring3(a: unicodestring): unicodestring;
+function testunicodestring4(a: unicodestring): unicodestring;
+function testunicodestring5: unicodestring;
+function testunicodestring6: unicodestring;
+function testunicodestring7: unicodestring;
+
+procedure main(const args: array of string);
+
+
+var
+  myrec: trec;
+
+implementation
+
+uses
+  jdk15;
+
+{ package visibility }
+var
+  testglobal: jint;
+
+var
+  funkyl: longint;
+
+function funky: longint;
+  begin
+    result:=funkyl;
+    inc(funkyl);
+  end;
+
+
+function testset: jint;
+var
+  s,s2: set of 0..31;
+  c1, c2: cardinal;
+const
+  exit1: jint = 1;
+begin
+  result:=0;
+  s:=[3..6];
+  s:=s+[10..20];
+  if not([3..4]<=s) then
+    exit(exit1);
+  s:=s-[15..20];
+  s2:=[15..20];
+  if s2<=s then
+    exit(2);
+  s:=s+s2;
+  if not(s2<=s) then
+    exit(3);
+  if s<=s2 then
+    exit(4);
+  c1:=1234;
+  c2:=c1 mod 5;
+  if c2<>4 then
+    exit(5);
+end;
+
+function testloop: longint;
+var
+  i,j: longint;
+const
+  exit1: jint = 1;
+begin
+  result:=0;
+  i:=0;
+  while i<10 do
+    i:=i+1;
+  if i<>10 then
+    exit(exit1);
+
+  i:=0;
+  repeat
+    i:=i+5;
+  until i=20;
+  if (i<20) or
+     (i>20)  then
+    exit(2);
+
+  j:=0;
+  for i:=1 to 10 do
+    j:=j+i;
+  if (j<(i*(i+1) div 2)) or
+    (j>(i*(i+1) div 2)) then
+   exit(3);
+end;
+
+function testfloat: jint;
+var
+  s1, s2: single;
+  d1, d2: double;
+begin
+  result:=0;
+  s1:=0.5;
+  s1:=s1+1.5;
+  s2:=2.0;
+  if (s1 < s2) or
+     (s1 > s2) or
+     (s1 <> s2) then
+    exit(1);
+  s1:=s1+s2;
+  if s1<>4.0 then
+    exit(2);
+  s1:=s1-s2;
+  if s1<>s2 then
+    exit(3);
+  s1:=s1*s2;
+  if s1<>4.0 then
+    exit(4);
+  s1:=s1/s2;
+  if s1<>s2 then
+    exit(5);
+
+  d1:=0.5;
+  d1:=d1+1.5;
+  d2:=2.0;
+  if (d1 < d2) or
+     (d1 > d2) or
+     (d1 <> d2) then
+    exit(6);
+  d1:=d1+d2;
+  if d1<>4.0 then
+    exit(7);
+  d1:=d1-d2;
+  if d1<>d2 then
+    exit(8);
+  d1:=d1*d2;
+  if d1<>4.0 then
+    exit(9);
+  d1:=d1/d2;
+  if d1<>d2 then
+    exit(10);
+end;
+     
+function testcnvint1: longint;
+var
+ tobyte : byte;
+ toword : word;
+ tolong : longint;
+{$ifndef tp}
+ toint64 : int64;
+{$endif}
+ b1  : boolean;
+ bb1 : bytebool;
+ wb1 : wordbool;
+ lb1 : longbool;
+ b2  : boolean;
+ bb2 : bytebool;
+ wb2 : wordbool;
+ lb2 : longbool;
+begin
+ result:=0;
+ { left : LOC_REGISTER  }
+ { from : LOC_REFERENCE/LOC_REGISTER }
+ b1 := TRUE;
+ tobyte := byte(b1);
+ if tobyte <> 1 then 
+   exit(1);
+ b1 := FALSE;
+ tobyte := byte(b1);
+ if tobyte <> 0 then 
+   exit(2);
+ b1 := TRUE;
+ toword := word(b1);
+ if toword <> 1 then 
+   exit(3);
+ b1 := FALSE;
+ toword := word(b1);
+ if toword <> 0 then 
+   exit(4);
+ b1 := TRUE;
+ tolong := longint(b1);
+ if tolong <> 1 then 
+   exit(5);
+ b1 := FALSE;
+ tolong := longint(b1);
+ if tolong <> 0 then 
+   exit(6);
+ bb1 := TRUE;
+ tobyte := byte(bb1);
+ if tobyte <> 255 then 
+   exit(7);
+ bb1 := FALSE;
+ tobyte := byte(bb1);
+ if tobyte <> 0 then 
+   exit(8);
+ bb1 := TRUE;
+ toword := word(bb1);
+ if toword <> 65535 then 
+   exit(9);
+ bb1 := FALSE;
+ toword := word(bb1);
+ if toword <> 0 then 
+   exit(10);
+ bb1 := TRUE;
+ tolong := longint(bb1);
+ if tolong <> -1 then 
+   exit(11);
+ bb1 := FALSE;
+ tolong := longint(bb1);
+ if tolong <> 0 then 
+   exit(12);
+ wb1 := TRUE;
+ tobyte := byte(wb1);
+ if tobyte <> 255 then 
+   exit(13);
+ wb1 := FALSE;
+ tobyte := byte(wb1);
+ if tobyte <> 0 then 
+   exit(14);
+ wb1 := TRUE;
+ toword := word(wb1);
+ if toword <> 65535 then 
+   exit(15);
+ wb1 := FALSE;
+ toword := word(wb1);
+ if toword <> 0 then 
+   exit(16);
+ wb1 := TRUE;
+ tolong := longint(wb1);
+ if tolong <> -1 then 
+   exit(17);
+ wb1 := FALSE;
+ tolong := longint(wb1);
+ if tolong <> 0 then 
+   exit(18);
+{$ifndef tp}
+ b1 := TRUE;
+ toint64 :=int64(b1);
+ if toint64 <> 1 then 
+   exit(19);
+ b1 := FALSE;
+ toint64 :=int64(b1);
+ if toint64 <> 0 then 
+   exit(20);
+ bb1 := TRUE;
+ toint64 :=int64(bb1);
+ if toint64 <> -1 then 
+   exit(21);
+ bb1 := FALSE;
+ toint64 :=int64(bb1);
+ if toint64 <> 0 then 
+   exit(22);
+ wb1 := TRUE;
+ toint64 :=int64(wb1);
+ if toint64 <> -1 then 
+   exit(23);
+ wb1 := FALSE;
+ toint64 :=int64(wb1);
+ if toint64 <> 0 then 
+   exit(24);
+{$endif}
+ lb1 := TRUE;
+ tobyte := byte(lb1);
+ if tobyte <> 255 then 
+   exit(25);
+ lb1 := FALSE;
+ tobyte := byte(lb1);
+ if tobyte <> 0 then 
+   exit(26);
+ lb1 := TRUE;
+ toword := word(lb1);
+ if toword <> 65535 then 
+   exit(27);
+ lb1 := FALSE;
+ toword := word(lb1);
+ if toword <> 0 then 
+   exit(28);
+ lb1 := TRUE;
+ tolong := longint(lb1);
+ if tolong <> -1 then 
+   exit(29);
+ lb1 := FALSE;
+ tolong := longint(lb1);
+ if tolong <> 0 then 
+   exit(30);
+ { left : LOC_REGISTER }
+ { from : LOC_REFERENCE }
+ wb1 := TRUE;
+ b2 := wb1;
+ if not b2 then 
+   exit(31);
+ wb1 := FALSE;
+ b2 := wb1;
+ if b2 then 
+   exit(32);
+ lb1 := TRUE;
+ b2 := lb1;
+ if not b2 then 
+   exit(33);
+ lb1 := FALSE;
+ b2 := lb1;
+ if b2 then 
+   exit(34);
+
+ wb1 := TRUE;
+ bb2 := wb1;
+ if not bb2 then 
+   exit(35);
+ wb1 := FALSE;
+ bb2 := wb1;
+ if bb2 then 
+   exit(36);
+ lb1 := TRUE;
+ bb2 := lb1;
+ if not bb2 then 
+   exit(37);
+ lb1 := FALSE;
+ bb2 := lb1;
+ if bb2 then 
+   exit(38);
+ b1 := TRUE;
+ lb2 := b1;
+ if not lb2 then 
+   exit(39);
+ b1 := FALSE;
+ lb2 := b1;
+ if lb2 then 
+   exit(40);
+ bb1 := TRUE;
+ lb2 := bb1;
+ if not lb2 then 
+   exit(41);
+ bb1 := FALSE;
+ lb2 := bb1;
+ if lb2 then 
+   exit(42);
+ { left : LOC_REGISTER }
+ { from : LOC_JUMP     }
+ toword := 0;
+ tobyte := 1;
+ tobyte:=byte(toword > tobyte);
+ if tobyte <> 0 then 
+   exit(43);
+ toword := 2;
+ tobyte := 1;
+ tobyte:=byte(toword > tobyte);
+ if tobyte <> 1 then 
+   exit(44);
+ toword := 0;
+ tobyte := 1;
+ toword:=word(toword > tobyte);
+ if toword <> 0 then 
+   exit(45);
+ toword := 2;
+ tobyte := 1;
+ toword:=word(toword > tobyte);
+ if toword <> 1 then 
+   exit(46);
+ toword := 0;
+ tobyte := 1;
+ tolong:=longint(toword > tobyte);
+ if tolong <> 0 then 
+   exit(47);
+ toword := 2;
+ tobyte := 1;
+ tolong:=longint(toword > tobyte);
+ if tolong <> 1 then 
+   exit(48);
+{$ifndef tp}
+ toword := 0;
+ tobyte := 1;
+ toint64:=int64(toword > tobyte);
+ if toint64 <> 0 then 
+   exit(49);
+ toword := 2;
+ tobyte := 1;
+ toint64:=int64(toword > tobyte);
+ if toint64 <> 1 then 
+   exit(50);
+{$endif}
+ { left : LOC_REGISTER }
+ { from : LOC_FLAGS     }
+ wb1 := TRUE;
+ bb1 := FALSE;
+ bb1 := (wb1 <> bb1);
+ if not bb1 then 
+   exit(51);
+ wb1 := FALSE;
+ bb1 := FALSE;
+ bb1 := (wb1 <> bb1);
+ if bb1 then 
+   exit(52);
+ lb1 := TRUE;
+ bb1 := FALSE;
+ bb1 := (bb1 = lb1);
+ if bb1 then 
+   exit(53);
+ lb1 := FALSE;
+ bb1 := TRUE;
+ bb1 := (bb1 <> lb1);
+ if not bb1 then 
+   exit(54);
+ lb1 := TRUE;
+ bb1 := FALSE;
+ wb1 := (bb1 = lb1);
+ if wb1 then 
+   exit(55);
+ lb1 := TRUE;
+ bb1 := TRUE;
+ wb1 := (bb1 = lb1);
+ if not wb1 then 
+   exit(56);
+ lb1 := TRUE;
+ bb1 := FALSE;
+ lb1 := (bb1 = lb1);
+ if lb1 then 
+   exit(57);
+ lb1 := FALSE;
+ bb1 := FALSE;
+ lb1 := (bb1 = lb1);
+ if not lb1 then 
+   exit(58);
+ bb1 := TRUE;
+ bb2 := FALSE;
+ lb1 := (bb1 <> bb2);
+ if not lb1 then 
+   exit(59);
+ bb1 := FALSE;
+ bb2 := TRUE;
+ lb1 := (bb1 = bb2);
+ if lb1 then 
+   exit(60);
+end;
+
+function testint2real: longint;
+var
+  l: longint;
+  c: cardinal;
+  i: int64;
+  q: qword;
+  s: single;
+  d: double;
+begin
+  result:=0;
+  l:=-12345;
+  c:=high(longint)+33;
+  i:=-56789;
+  q:=qword(high(int64))+48;
+
+  s:=l;
+  if s<>-12345 then
+    exit(1);
+  s:=c;
+  if s<>high(longint)+33 then
+    exit(2);
+  s:=i;
+  if s<>-56789 then
+    exit(3);
+  s:=q;
+  if s<>qword(high(int64))+48 then
+    exit(4);
+  
+  l:=-12345;
+  c:=high(longint)+33;
+  i:=-56789;
+  q:=qword(high(int64))+48;
+
+  d:=l;
+  if d<>-12345 then
+    exit(5);
+  d:=c;
+  if d<>high(longint)+33 then
+    exit(6);
+  d:=i;
+  if d<>-56789 then
+    exit(7);
+  d:=q;
+  if d<>qword(high(int64))+48 then
+    exit(8);
+
+
+  l:=123456789;
+  c:=987654321;
+  i:=high(cardinal)+12345;
+  q:=12345;
+
+  s:=l;
+  if s<>123456789 then
+    exit(11);
+  s:=c;
+  if s<>987654321 then
+    exit(12);
+  s:=i;
+  if s<>high(cardinal)+12345 then
+    exit(13);
+  s:=q;
+  if s<>12345 then
+    exit(14);
+
+  l:=123456789;
+  c:=987654321;
+  i:=high(cardinal)+12345;
+  q:=12345;
+
+  d:=l;
+  if d<>123456789 then
+    exit(16);
+  d:=c;
+  if d<>987654321 then
+    exit(17);
+  d:=i;
+  if d<>high(cardinal)+12345 then
+    exit(18);
+  d:=q;
+  if d<>12345 then
+    exit(19);
+end;
+
+{   low = high           }
+function TestCmpListOneShort: longint;
+ var
+  s: smallint;
+  failed :boolean;
+ begin
+   s := -12;
+   failed := true;
+   case s of
+   -12 : failed := false;
+   -10 : ;
+   3 : ;
+   else
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListTwoShort: longint;
+ var
+  s: smallint;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   -12 : ;
+   -10 : ;
+   3 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+
+{   low = high           }
+function TestCmpListOneWord: longint;
+ var
+  s: word;
+  failed :boolean;
+ begin
+   s := 12;
+   failed := true;
+   case s of
+   12 : failed := false;
+   10 : ;
+   3 : ;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListTwoWord: longint;
+ var
+  s: word;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   0 : ;
+   512 : ;
+   3 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListOneInt64: longint;
+ var
+  s: int64;
+  failed :boolean;
+ begin
+   s := 3000000;
+   failed := true;
+   case s of
+   3000000 : failed := false;
+   10 : ;
+   3 : ;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListTwoInt64: longint;
+ var
+  s: int64;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   0 : ;
+   512 : ;
+   3 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+ {   low = high           }
+ function TestCmpListThreeInt64: longint;
+  var
+   s: int64;
+   l : longint;
+   failed :boolean;
+  begin
+    l:=3000000;
+    s := (int64(l) shl 32);
+    failed := true;
+    case s of
+    (int64(3000000) shl 32) : failed := false;
+    10 : ;
+    3 : ;
+    end;
+    if failed then
+      result:=1
+    else
+      result:=0;
+  end;
+
+
+function TestCmpListRangesOneShort: longint;
+ var
+  s: smallint;
+  failed :boolean;
+ begin
+   s := -12;
+   failed := true;
+   case s of
+   -12..-8 : failed := false;
+   -7 : ;
+   3 : ;
+   else
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+function TestCmpListRangesTwoShort: longint;
+ var
+  s: smallint;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   -12..-8 : ;
+   -7 : ;
+   3 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+
+{   low = high           }
+function TestCmpListRangesOneWord: longint;
+ var
+  s: word;
+  failed :boolean;
+ begin
+   s := 12;
+   failed := true;
+   case s of
+   12..13 : failed := false;
+   10 : ;
+   3..7 : ;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListRangesTwoWord: longint;
+ var
+  s: word;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   0..2 : ;
+   3..29999 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+
+ function TestCmpListRangesThreeWord: longint;
+  var
+   s: word;
+   failed :boolean;
+  begin
+    s := 3;
+    failed := true;
+    case s of
+    12..13 : ;
+    10 : ;
+    3..7 : failed := false;
+    end;
+    if failed then
+      result:=1
+    else
+      result:=0;
+  end;
+
+
+{   low = high           }
+function TestCmpListRangesOneInt64: longint;
+ var
+  s: int64;
+  failed :boolean;
+ begin
+   s := 3000000;
+   failed := true;
+   case s of
+   11..3000000 : failed := false;
+   10 : ;
+   0..2 : ;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+{   low = high           }
+function TestCmpListRangesTwoInt64: longint;
+ var
+  s: int64;
+  failed :boolean;
+ begin
+   s := 30000;
+   failed := true;
+   case s of
+   513..10000 : ;
+   512 : ;
+   0..3 : ;
+   else
+     failed := false;
+   end;
+   if failed then
+     result:=1
+   else
+     result:=0;
+ end;
+
+function testsqr: longint;
+  var
+    s1, s2: single;
+    d1, d2: double;
+  begin
+    result:=0;
+    s1:=25.0;
+    s2:=sqr(s1);
+    if s2<>625.0 then
+      exit(1);
+    d2:=sqr(s1);
+    if d2<>625.0 then
+      exit(2);
+    d1:=7.0;
+    d2:=sqr(d1);
+    if d2<>49.0 then
+      exit(3);
+    d2:=sqr(d1);
+    if d2<>49.0 then
+      exit(4);
+  end;
+
+function testtrunc: longint;
+  var
+    s1: single;
+    d1: double;
+    l: longint;
+    i: int64;
+  begin
+    result:=0;
+    s1:=123.99;
+    l:=trunc(s1);
+    if l<>123 then
+      exit(1);
+    i:=trunc(s1);
+    if i<>123 then
+      exit(2);
+    d1:=67533.345923;
+    l:=trunc(d1);
+    if l<>67533 then
+      exit(3);
+    i:=trunc(d1);
+    if i<>67533 then
+      exit(4);
+  end;
+
+function testdynarr: longint;
+  type
+    TReal1DArray        = array of Double;
+    TReal2DArray        = array of array of Double;
+  var
+    MaxMN : Integer;
+    PassCount : Integer;
+    Threshold : Double;
+    AEffective : TReal2DArray;
+    AParam : TReal2DArray;
+    XE : TReal1DArray;
+    B : TReal1DArray;
+    N : Integer;
+    Pass : Integer;
+    I : Integer;
+    J : Integer;
+    CntS : Integer;
+    CntU : Integer;
+    CntT : Integer;
+    CntM : Integer;
+    WasErrors : Boolean;
+    IsUpper : Boolean;
+    IsTrans : Boolean;
+    IsUnit : Boolean;
+    V : Double;
+    S : Double;
+  begin    
+    SetLength(AEffective, 2, 2);           // crash occurs at this line
+    WasErrors := False;
+    MaxMN := 10;
+    PassCount := 5;
+    N:=2;
+    isupper:=false;
+    isunit:=true;
+    istrans:=false;
+    while N<=MaxMN do
+    begin
+        for i:=low(aeffective) to pred(length(aeffective)) do
+          for j:=low(aeffective[i]) to pred(length(aeffective[i])) do
+            aeffective[i,j]:=i*10+j;
+        SetLength(AEffective, N+1, N+1);
+        for i:=low(aeffective) to pred(length(aeffective))-1 do
+          for j:=low(aeffective[i]) to pred(length(aeffective[i]))-1 do
+            if aeffective[i,j]<>i*10+j then
+              begin
+                result:=-1;
+                exit;
+              end;
+        for i:=low(aeffective) to pred(length(aeffective))-1 do
+          if aeffective[i,pred(length(aeffective[i]))]<>0 then
+            begin
+              result:=-2;
+              exit;
+            end;
+        Inc(N);
+    end;
+    { check shallow copy }
+    AParam:=aeffective;
+    aeffective[1,1]:=123;
+    if AParam[1,1]<>123 then
+      exit(-3);
+    result:=0;
+  end;
+
+
+function testdynarr2: longint;
+  type
+    tstaticarr = array[0..1] of longint;
+    tstaticarr2 = array[0..1] of array of array of longint;
+  var
+    a,b: array of array of tstaticarr;
+    c,d: tstaticarr2;
+    w: word;
+    arrb: array of byte;
+    arrc: array of char;
+    arrw: array of word;
+    arrwc: array of unicodechar;
+    arrd: array of dword;
+    arrq: array of qword;
+    arra: array of ansistring;
+    arrs: array of shortstring;
+  begin
+    setlength(a,2,2);
+    a[0,0,0]:=1;
+    b:=a;
+    a[0,0,1]:=1;
+    funkyl:=1;
+    setlength(a[funky],35);
+    if b[0,0,0]<>1 then
+      exit(1);
+    if b[0,0,1]<>1 then
+      exit(2);
+    if length(b[1])<>35 then
+      exit(3);
+    setlength(c[0],2,2);
+    d:=c;
+    c[0,0,0]:=1;
+    setlength(c[1],42);
+    if d[0,0,0]<>1 then
+      exit(4);
+    if length(d[1])<>0 then
+      exit(5);
+    b[1,0,0]:=555;
+    a:=copy(b,1,1);
+    if length(a)<>1 then
+      exit(6);
+    if a[0,0,0]<>555 then
+      exit(7);
+    
+    setlength(arrb,4);
+    if length(arrb)<>4 then
+      exit(8);
+    for w:=low(arrb) to high(arrb) do
+      if arrb[w]<>0 then
+        exit(9);
+    
+    setlength(arrc,32);
+    if length(arrc)<>32 then
+      exit(10);
+    for w:=low(arrc) to high(arrc) do
+      if arrc[w]<>#0 then
+        exit(11);
+
+    setlength(arrw,666);
+    if length(arrw)<>666 then
+      exit(11);
+    for w:=low(arrw) to high(arrw) do
+      if arrw[w]<>0 then
+        exit(12);
+
+    setlength(arrwc,12346);
+    if length(arrwc)<>12346 then
+      exit(13);
+    for w:=low(arrwc) to high(arrwc) do
+      if arrwc[w]<>#0 then
+        exit(14);
+
+    setlength(arrd,20000);
+    if length(arrd)<>20000 then
+      exit(15);
+    for w:=low(arrd) to high(arrd) do
+      if arrd[w]<>0 then
+        exit(16);
+
+    setlength(arrq,21532);
+    if length(arrq)<>21532 then
+      exit(17);
+    for w:=low(arrq) to high(arrq) do
+      if arrq[w]<>0 then
+        exit(18);
+
+    setlength(arra,21533);
+    if length(arra)<>21533 then
+      exit(19);
+    for w:=low(arra) to high(arra) do
+      if arra[w]<>'' then
+        exit(20);
+
+    setlength(arrs,21534);
+    if length(arrs)<>21534 then
+      exit(21);
+    for w:=low(arrs) to high(arrs) do
+      if arrs[w]<>'' then
+        exit(12);
+
+    result:=0;
+  end;
+
+
+function testbitcastintfloat: jint;
+var
+  f: jfloat;
+  d: jdouble;
+  i: jint;
+  l: jlong;
+begin
+  result:=-1;
+  f:=123.125;
+  i:=jint(f);
+  f:=1.0;
+  f:=jfloat(i);
+  if f<>123.125 then
+    exit;
+
+  result:=-2;
+  d:=9876.0625;
+  l:=jlong(d);
+  d:=1.0;
+  d:=jdouble(l);
+  if d<>9876.0625 then
+    exit;
+  result:=0;
+end;
+
+{ ********************** Is test  ******************** }
+
+type
+ tisclass2 = class(tisclass1)
+   constructor create;
+ end;
+ 
+ constructor tisclass1.create;
+   begin
+   end;
+   
+ constructor tisclass1.tisclass1nested.create;
+   begin
+     anonrec.c:='x';
+   end;
+   
+ function tisclass1.tisclass1nested.testl1: jint;
+   begin
+     if anonrec.c='x' then
+       result:=12345
+     else
+       result:=-1;
+   end;
+   
+ constructor tisclass1.tisclass1nested.tisclass1nestedl2.create;
+   begin
+     anonrec.l:=961;
+   end;
+   
+ function tisclass1.tisclass1nested.tisclass1nestedl2.testl2: jint;
+   begin
+     if anonrec.l=961 then
+       result:=42
+    else
+      result:=-1;
+   end;
+   
+ procedure tisclass1.abstr;
+   begin
+   end;
+   
+   
+ constructor tisclass2.create;
+   begin
+   end;
+   
+   
+function testispara(cref: tisclass1ref): longint;
+begin
+  if cref<>tisclass2 then
+    result:=14;
+  result:=0;
+end;
+
+function testis: longint;
+var
+ myclass1 : tisclass1;
+ myclass2 : tisclass2;
+ nested1  : tisclass1.tisclass1nested;
+ nested2  : tisclass1.tisclass1nested.tisclass1nestedl2;
+ myclassref : tisclass1ref;
+begin
+  { create class instance }
+  myclass1:=tisclass1.create;
+  myclass2:=tisclass2.create;
+  {if myclass1 is tisclass1 }
+  if not(myclass1 is tisclass1) then
+    exit(1);
+  if (myclass1 is tisclass2) then
+    exit(2);
+  if not (myclass2 is tisclass2) then
+    exit(3);
+  if (myclass1 is tisclass2) then
+    exit(4);
+    
+  nested1:=tisclass1.tisclass1nested.create;
+  nested2:=tisclass1.tisclass1nested.tisclass1nestedl2.create;
+  if not(nested1 is tisclass1.tisclass1nested) then
+    exit(5);
+  if nested1.testl1<>12345 then
+    exit(6);
+  if not(nested2 is tisclass2.tisclass1nested.tisclass1nestedl2) then
+    exit(7);
+  if nested2.testl2<>42 then
+    exit(8);
+
+    
+{$ifndef oldcomp}
+  myclassref:=tisclass1;
+  if not(myclass1 is myclassref) then
+    exit(10);
+  if not(myclass2 is myclassref) then
+    exit(11);
+
+  myclassref:=tisclass2;
+  if (myclass1 is myclassref) then
+    exit(12);
+  if not(myclass2 is myclassref) then
+    exit(13);
+    
+  myclass1:=myclass2;
+  myclass1.abstr;
+  myclass2:=tisclass2(myclass1 as myclassref);
+
+  result:=testispara(tisclass2);
+  if result<>0 then
+    exit(14);
+  
+  if not(nested1 is tisinterface) then
+    exit(15);
+    
+  if nested2 is tisinterface then
+    exit(16);
+  
+{$endif}
+
+  result:=0;
+end;
+
+function testneg: longint;
+var
+  b: shortint;
+  l: longint;
+  i: int64;
+  s: single;
+  d: double;
+begin
+  b:=1;
+  b:=-b;
+  if b<>-1 then
+    exit(1);
+  l:=-1234567;
+  l:=-l;
+  if l<>1234567 then
+    exit(2);
+  i:=-123456789012345;
+  i:=-i;
+  if i<>123456789012345 then
+    exit(3);
+  s:=123.5;
+  s:=-s;
+  if s<>-123.5 then
+    exit(4);
+  d:=-4567.78;
+  d:=-d;
+  if d<>4567.78 then
+    exit(5);
+  result:=0;
+end;
+
+
+
+{ ******************** End Is test  ****************** }
+
+{ ****************** Exception test  ***************** }
+
+function testtry1: longint;
+  begin
+    result:=-1;
+    try
+      raise JLException.create;
+    except
+      result:=0;
+    end;
+  end;
+
+function testtry2: longint;
+  begin
+    result:=-1;
+    try
+      raise JLException.create;
+    except
+      on JLException do
+        result:=0;
+      else
+        result:=-2
+    end;
+    if result<>0 then
+      exit;
+    result:=-3;
+    try
+      try
+        raise JLException.create;
+      except
+        result:=-4;
+        raise
+      end;
+    except
+      on JLException do
+        if result=-4 then
+          result:=0;
+    end;
+  end;
+
+function testtryfinally1: longint;
+  begin
+    result:=-1;
+    try
+      try
+        try
+          raise JLException.create;
+        except
+          on JLException do
+            begin
+              result:=1;
+              raise;
+            end
+          else
+            result:=-2
+        end;
+      finally
+        if result=1 then
+          result:=0;
+      end;
+    except
+      on JLException do
+        if result<>0 then
+          raise
+    end;
+  end;
+
+function testtryfinally2: longint;
+var
+  i,j: longint;
+  check1, check2: byte;
+begin
+  j:=0;
+  check1:=0;
+  check2:=0;
+  result:=-1;
+  try
+    for i:=1 to 10 do
+      try
+        inc(j);
+        if j=1 then
+          begin
+            inc(check1);
+            continue;
+          end;
+        if j=2 then
+          begin
+            inc(check2);
+            break;
+          end;
+      finally
+        if j=1 then
+          inc(check1);
+        if j=2 then
+          inc(check2);
+      end;
+  finally
+    if check1<>2 then
+      result:=-1
+    else if check2<>2 then
+      result:=-2
+    else if j<>2 then
+      result:=-3
+    else
+      result:=0;
+  end;
+end;
+
+function testtryfinally3: longint;
+var
+  i,j: longint;
+  check1, check2: byte;
+begin
+  j:=0;
+  check1:=0;
+  check2:=0;
+  result:=-1;
+  try
+    for i:=1 to 10 do
+      try
+        inc(j);
+        if j=1 then
+          begin
+            inc(check1);
+            continue;
+          end;
+        if j=2 then
+          begin
+            inc(check2);
+            exit;
+          end;
+      finally
+        if j=1 then
+          inc(check1);
+        if j=2 then
+          inc(check2);
+      end;
+  finally
+    if check1<>2 then
+      result:=-10
+    else if check2<>2 then
+      result:=-20
+    else if j<>2 then
+      result:=-30
+    else
+      result:=0;
+  end;
+end;
+
+
+{ **************** End Exception test  *************** }
+
+{ **************** Begin array test  *************** }
+
+function testsmallarr1: longint;
+  type
+    tarr = array[4..6] of longint;
+  var
+    a1,a2: tarr;
+    a3,a4: array[1..2,3..5] of tarr;
+    i,j,k: longint;
+  begin
+    a1[4]:=1;
+    a1[5]:=2;
+    a1[6]:=3;
+    { plain copy }
+    a2:=a1;
+    if (a2[4]<>1) or
+       (a2[5]<>2) or
+       (a2[6]<>3) then
+      exit(1);
+    { has to be deep copy }
+    a1[5]:=255;
+    if a2[5]<>2 then
+      exit(2);
+    { copy to multi-dim array }
+    a3[1,4]:=a1;
+    if (a3[1,4,4]<>1) or
+       (a3[1,4,5]<>255) or
+       (a3[1,4,6]<>3) then
+      exit(3);
+   
+    i:=2;
+    j:=3;
+    a1[4]:=38;
+    a1[5]:=39;
+    a1[6]:=40;
+    { copy to multi-dim array }
+    a3[i,j]:=a1;
+    if (a3[i,j,4]<>38) or
+       (a3[i,j,5]<>39) or
+       (a3[i,j,6]<>40) then
+      exit(4);
+      
+    { copy multi-dim array to multi-dim array }
+    a4:=a3;
+    { check for deep copy }
+    for i:=low(a3) to high(a3) do
+      for j:=low(a3[i]) to high(a3[i]) do
+        for k:=low(a3[i,j]) to high(a3[i,j]) do
+          a3[i,j,k]:=-1;
+    
+    if (a4[1,4,4]<>1) or
+       (a4[1,4,5]<>255) or
+       (a4[1,4,6]<>3) then
+      exit(5);
+    i:=2;
+    j:=3;
+    if (a4[i,j,4]<>38) or
+       (a4[i,j,5]<>39) or
+       (a4[i,j,6]<>40) then
+      exit(6);
+
+    result:=0;
+  end;
+
+
+function testopenarrval(a1: longint; arr: array of jfloat; a2: longint): longint;
+  var
+    i: longint;
+  begin
+    result:=a1+length(arr)+trunc(arr[high(arr)])+a2;
+    for i:=low(arr) to high(arr) do
+      arr[i]:=1.0;
+  end;
+  
+function testopenarrconst(a1: longint; const arr: array of jfloat; a2: longint): longint;
+  begin
+    result:=a1+length(arr)+trunc(arr[high(arr)])+a2;
+  end;
+
+function testopenarrvar(a1: longint; var arr: array of jfloat; a2: longint): longint;
+  begin
+    result:=a1+length(arr)+trunc(arr[high(arr)])+a2;
+    arr[0]:=3.0;
+  end;
+
+function testopenarr1: longint;
+  var
+    arr: array[4..10] of jfloat;
+    i: longint;
+  begin
+    result:=0;
+    arr[10]:=2.0;
+    if testopenarrval(1,arr,3)<>13 then
+      exit(1);
+    for i:=4 to 9 do
+      if arr[i]<>0.0 then
+        exit(2);
+    if arr[10]<>2.0 then
+      exit(3);
+      
+    if testopenarrconst(2,arr,4)<>15 then
+      exit(4);
+    if testopenarrvar(3,arr,5)<>17 then
+      exit(5);
+    if arr[4]<>3.0 then
+      exit(6);
+  end;
+
+type
+  tarrdynarr = array[1..10,1..4] of array of array of byte;
+function testoutopenarrdyn(out arr: array of tarrdynarr): longint;
+  var
+    i, j, k: longint;
+  begin
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        for k:=low(arr[i][j]) to high(arr[i][j]) do
+          begin
+            if length(arr[i][j,k])<>0 then
+              exit(-1);
+            setlength(arr[i][j,k],j,k);
+          end;
+    result:=0;
+  end;
+
+function testopenarr2: longint;
+  var
+    arr: array[20..30] of tarrdynarr;
+    dynarr: array of tarrdynarr;
+    i,j,k: longint;
+    barr, barr2: array of byte;
+    rarr: array of trec;
+    rarr2: array of array of trec;
+  begin
+    setlength(barr,4);
+    barr[1]:=4;
+    if barr[1]<>4 then
+      exit(-40);
+    barr2:=copy(barr);
+    if barr2[1]<>4 then
+      exit(-50);
+    barr2[2]:=48;
+    if barr[2]=48 then
+      exit(-60);
+    setlength(rarr,5);
+    rarr[4].a:=135;
+    if rarr[4].a<>135 then
+      exit(-70);
+    setlength(rarr2,4,5);
+    rarr2[3,4].b:=124;
+    if rarr2[3,4].b<>124 then
+      exit(-80);
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        for k:=low(arr[i][j]) to high(arr[i][j]) do
+          begin
+            setlength(arr[i][j,k],20,20);
+          end;
+    result:=testoutopenarrdyn(arr);
+    if result<>0 then
+      exit;
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        for k:=low(arr[i][j]) to high(arr[i][j]) do
+          begin
+            if (length(arr[i][j,k])<>j) then
+              exit(-2);
+            if (length(arr[i][j,k][0])<>k) then
+              exit(-3);
+            if (length(arr[i][j,k][j-1])<>k) then
+              exit(-4);
+          end;
+    setlength(dynarr,31);
+    result:=testoutopenarrdyn(dynarr);
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        for k:=low(arr[i][j]) to high(arr[i][j]) do
+          begin
+            if (length(arr[i][j,k])<>j) then
+              exit(-5);
+            if (length(arr[i][j,k][0])<>k) then
+              exit(-6);
+            if (length(arr[i][j,k][j-1])<>k) then
+              exit(-7);
+          end;
+  end;
+
+
+function testopenarr3: longint;
+  var
+    arr: array[4..10] of jfloat;
+    i: longint;
+  begin
+    result:=0;
+    arr[10]:=2.0;
+    if testopenarrval(1,[1.0,2.0,3.0,4.0,5.0,6.0,2.0],3)<>13 then
+      exit(1);
+      
+    if testopenarrconst(2,[1.0,2.0,3.0,4.0,5.0,6.0,7.0],4)<>20 then
+      exit(2);
+  end;
+
+type
+ ByteArray = array of byte;
+
+procedure FillChar(var X: Array of Byte; Count: integer; Value: byte; FirstIndex: integer);
+  var
+   i: integer;
+   y: bytearray;
+  begin
+   for i := FirstIndex to (FirstIndex + Count) - 1 do
+     X[i] := Value;
+  end;
+
+function Err : ByteArray;
+  begin
+   SetLength(Result, 10);
+   FillChar(Result, Length(Result)-2, 1, 2);  // !!!!
+  end;
+
+function testopendynarr: longint;
+  var
+    x: bytearray; 
+    i: longint;
+  begin
+    x:=err;
+    for i:=0 to 1 do
+      if x[i]<>0 then
+        exit(1);
+    for i:=2 to high(x) do
+      if x[i]<>1 then
+        exit(2);
+    result:=0;
+  end;
+
+
+type
+  tdoublearray10 = array[1..10] of jdouble;
+  
+function testarrval(arr: tdoublearray10): double;
+  var
+    i: longint;
+  begin
+    result:=0.0;
+    for i:=low(arr) to high(arr) do
+      begin
+        result:=result+arr[i];
+        arr[i]:=-1.0;
+      end;
+  end;
+
+function testsmallarr2: longint;
+  var
+    arr: tdoublearray10;
+    i: longint;
+    barr1,barr2: array[1..2] of byte;
+  begin
+    result:=0;
+    for i:=low(arr) to high(arr) do
+      arr[i]:=i;
+    if testarrval(arr)<>(10*11 div 2) then
+      exit(1);
+    for i:=low(arr) to high(arr) do
+      if arr[i]<>i then
+        exit(2);
+    barr1[1]:=1;
+    barr1[2]:=2;
+    barr2:=barr1;
+    if barr2[1]<>1 then
+      exit(3);
+    if barr2[2]<>2 then
+      exit(4);
+  end;
+
+type
+  tsmall2darr = array[1..10,5..9] of longint;
+
+function smallarr2dfunc: tsmall2darr;
+  var
+    i, j: longint;
+  begin
+    for i:=low(result) to high(result) do
+      for j:=low(result[i]) to high(result[i]) do
+        result[i,j]:=i*(high(result[i])-low(result[i])+1)+(j-low(result[i]));
+  end;
+
+function testsmallarr3: longint;
+  var
+    a: tsmall2darr;
+  begin
+    a:=smallarr2dfunc;
+    if a[1,5]<>5 then
+      exit(1);
+    if a[2,9]<>14 then
+      exit(2);
+    result:=0;
+  end;
+
+function testoutarrdyn(out arr: tarrdynarr): longint;
+  var
+    i, j: longint;
+  begin
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        begin
+          if length(arr[i,j])<>0 then
+            exit(-1);
+          setlength(arr[i,j],i,j);
+        end;
+    result:=0;
+  end;
+
+function testsmallarr4: longint;
+  var
+    arr: tarrdynarr;
+    i,j: longint;
+  begin
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        begin
+          setlength(arr[i,j],20,20);
+        end;
+    result:=testoutarrdyn(arr);
+    if result<>0 then
+      exit;
+    for i:=low(arr) to high(arr) do
+      for j:=low(arr[i]) to high(arr[i]) do
+        begin
+          if (length(arr[i,j])<>i) then
+            exit(-2);
+          if (length(arr[i,j][0])<>j) then
+            exit(-3);
+          if (length(arr[i,j][i-1])<>j) then
+            exit(-4);
+        end;
+  end;
+  
+function testrec1: longint;
+  var
+    r1, r2: trec;
+  begin
+    r1.a:=1;
+    r1.b:=2;
+    r1.c:=3;
+    r1.d:=4;
+    r1.e:=5;
+    if r1.a<>1 then
+      exit(1);
+    if r1.b<>2 then
+      exit(2);
+    if r1.c<>3 then
+      exit(3);
+    if r1.d<>4 then
+      exit(4);
+    if r1.e<>5 then
+      exit(5);
+    r2:=r1;
+    if r2.a<>1 then
+      exit(6);
+    if r2.b<>2 then
+      exit(7);
+    if r2.c<>3 then
+      exit(8);
+    if r2.d<>4 then
+      exit(9);
+    if r2.e<>5 then
+      exit(10);
+    r2.a:=10;
+    if r1.a<>1 then
+      exit(11);
+    result:=0;
+  end;
+
+function testrec2: longint;
+  var
+    r1, r2: tnestrec;
+  begin
+    r1:=tcnestrec;
+    r1.r.a:=1;
+    r1.r.b:=2;
+    r1.r.c:=3;
+    r1.r.d:=4;
+    r1.r.e:=5;
+    r1.arr[4]:=6;
+    if r1.r.a<>1 then
+      exit(1);
+    if r1.r.b<>2 then
+      exit(2);
+    if r1.r.c<>3 then
+      exit(3);
+    if r1.r.d<>4 then
+      exit(4);
+    if r1.r.e<>5 then
+      exit(5);
+    if r1.arr[4]<>6 then
+      exit(12);
+    r2:=r1;
+    if r2.r.a<>1 then
+      exit(6);
+    if r2.r.b<>2 then
+      exit(7);
+    if r2.r.c<>3 then
+      exit(8);
+    if r2.r.d<>4 then
+      exit(9);
+    if r2.r.e<>5 then
+      exit(10);
+    if r1.arr[4]<>6 then
+      exit(13);
+    r2.r.a:=10;
+    r2.arr[4]:=7;
+    if r1.r.a<>1 then
+      exit(11);
+    if r1.arr[4]<>6 then
+      exit(14);
+    anonrec.s:='abcdef';
+    if anonrec.s<>'abcdef' then
+      exit(15);
+    result:=0;
+  end;
+
+
+function testopenarrvalrec(a1: longint; arr: array of trec; a2: longint): longint;
+  var
+    i: longint;
+  begin
+    result:=a1+length(arr)+arr[high(arr)].a+a2;
+    for i:=low(arr) to high(arr) do
+      arr[i].a:=123;
+  end;
+  
+function testopenarrconstrec(a1: longint; const arr: array of trec; a2: longint): longint;
+  begin
+    result:=a1+length(arr)+arr[high(arr)].b+a2;
+  end;
+
+function testopenarrvarrec(a1: longint; var arr: array of trec; a2: longint): longint;
+  begin
+    result:=a1+length(arr)+arr[high(arr)].c+a2;
+    arr[0].d:=987;
+  end;
+
+function testopenarr1rec: longint;
+  var
+    arr: array[4..10] of trec;
+    i: longint;
+  begin
+    result:=0;
+    arr[10].a:=2;
+    arr[10].b:=2;
+    arr[10].c:=2;
+    arr[10].d:=2;
+    arr[10].e:=2;
+    if testopenarrvalrec(1,arr,3)<>13 then
+      exit(1);
+    for i:=4 to 9 do
+      if arr[i].a<>0.0 then
+        exit(2);
+    if arr[10].a<>2.0 then
+      exit(3);
+      
+    if testopenarrconstrec(2,arr,4)<>15 then
+      exit(4);
+    if testopenarrvarrec(3,arr,5)<>17 then
+      exit(5);
+    if arr[4].d<>987 then
+      exit(6);
+  end;
+
+  
+function testunicodestring: JLString;
+  var
+    s1, s2: unicodestring;
+    sarr: array[0..0] of unicodestring;
+  begin
+    s1:='abc';
+    sarr[0]:=s1;
+    funkyl:=0;
+    if length(sarr[funky])<>3 then
+      begin
+        result:='';
+        exit;
+      end;
+    s2:=s1;
+    s2:='~ê∂êºîƒ~©¬';
+    result:=s2;
+  end;
+
+function testunicodestring2: JLString;
+  begin
+    result:='\'#13#10'"';
+  end;
+  
+function testunicodestring3(a: unicodestring): unicodestring;
+  begin
+    result:=a+'def';
+  end;
+  
+function testunicodestring4(a: unicodestring): unicodestring;
+  begin
+//    JLSystem.fout.println(JLString('in testunicodestring4'));
+//    JLSystem.fout.println(JLString(a));
+    result:=a;
+//    JLSystem.fout.println(JLString(result));
+    result[2]:='x';
+//    JLSystem.fout.println(JLString(result));
+    result[3]:='2';
+//    JLSystem.fout.println(JLString(result));
+  end;
+
+function testunicodestring5: unicodestring;
+  var
+    arr: array[0..3] of ansichar;
+    arr2: array[1..5] of ansichar;
+    c: ansichar;
+    wc: widechar;
+  begin
+    arr:='abc'#0;
+    arr2:='defgh';
+    c:='i';
+    wc:='j';
+    result:=arr+arr2;
+    result:=copy(result,1,length(result))+c;
+    result:=result+wc;
+  end;
+
+function testunicodestring6: unicodestring;
+  const
+    tcstr: string = 'ab';
+  var
+    arr: array[0..3] of widechar;
+    arr2: array[1..5] of widechar;
+    swap: ansichar;
+    wc: widechar;
+    i: longint;
+  begin
+    arr:='ab';
+    arr2:='cdefg';
+    swap:='h';
+    wc:='i';
+    result:=arr+arr2+swap;
+    result:=result+wc;
+  end;
+
+
+function testunicodestring7: unicodestring;
+  const
+    tcstr: string = 'ab';
+  var
+    arr: array[0..3] of unicodechar;
+    arr2: array[1..5] of unicodechar;
+    c: ansichar = 'h';
+    wc: unicodechar;
+  begin
+    funkyl:=1;
+    arr:=tcstr;
+    arr2:='cdefg';
+    wc:='i';
+    result:=arr+arr2;
+    result:=result+c;
+    result:=result+wc;
+    result[funky]:='x';
+  end;
+
+{ **************** End array test  *************** }
+
+
+constructor TMyClass.create;
+begin
+end;
+
+
+constructor TMyClass.create(l: longint);
+var
+  dummy: TMyClass;
+begin
+  dummy:=TMyClass.create;
+  create(l,l);
+end;
+
+constructor TMyClass.create(l1,l2: longint);
+begin
+  inherited create;
+  propintfield:=4;
+  if propintfield<>4 then
+    jlsystem.fout.println('WRONG!!!!!!!!!!!!!!!!!!!');
+end;
+
+function TMyClass.sub(a1, a2: longint): longint;
+begin
+  result:=a1-a2;
+end;
+
+
+function TMyClass.test(l1, l2: longint): longint;
+var
+  locall: longint;
+  localsub: TMyClass;
+begin
+  localsub:=TMyClass.create(1245);
+  locall:=localsub.sub(l1,l2);
+  result:=locall+1;
+  if result>4 then
+    result:=-1;
+end;
+
+class function tmyclass.staticmul3(l: longint): longint; static;
+begin
+  result:=l*3;
+end;
+
+procedure tmyclass.longboolobj(l: jlong; b: boolean; obj: tobject);
+begin
+  l:=5;
+  b:=true;
+  obj:=nil;
+end;
+
+
+procedure tmyclass.setintfield(l: jint);
+  const
+    xxx: longint = 4;
+  begin
+    intfield:=l;
+    longboolobj(xxx,true,self);
+  end;
+
+function tmyclass.getintfield: jint;
+  begin
+    result:=intfield;
+  end;
+
+procedure tmyclass.setstaticbytefield(b: byte);
+  begin
+    staticbytefield:=b;
+    myrec.a:=b;
+  end;
+
+
+function tmyclass.getstaticbytefield: byte;
+  begin
+    result:=staticbytefield;
+  end;
+
+
+class procedure tmyclass.setstaticbytefieldstatic(b: byte);
+  begin
+    staticbytefield:=b;
+  end;
+
+
+class function tmyclass.getstaticbytefieldstatic: byte;
+  begin
+    result:=staticbytefield;
+  end;
+
+
+class procedure tmyclass.settestglobal(l: longint);
+  begin
+    testglobal:=l;
+  end;
+
+class function tmyclass.gettestglobal: longint;
+  begin
+    result:=testglobal;
+  end;
+
+procedure main(const args: array of string);
+  begin
+    JLSystem.fout.println('This is the entry point');
+  end;
+
+
+begin
+  myrec.b:=1234;
+  TMyClass.rec.c:=5678;
+end.

tests/test/jvm/testall.bat

@@ -0,0 +1,182 @@
+ppcjvm -O2 -g unsupported
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g testintf
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g nested
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g test
+if %errorlevel% neq 0 exit /b %errorlevel%
+javac -encoding utf-8 -cp ..\..\..\rtl\units\jvm-java;. JavaClass
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. JavaClass
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g sort
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. sort
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g classmeth
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. classmeth
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g classlist
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. classlist
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g testansi
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. testansi
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tcnvstr1
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tcnvstr1
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tcnvstr3
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tcnvstr3
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g testshort
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. testshort
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tarray2
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tarray2
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tarray3
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tarray3
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tnestproc
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tnestproc
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g outpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. outpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tbytearrres
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tbytearrres
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g forw
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tbyte
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tbyte
+if %errorlevel% neq 0 exit /b %errorlevel%
+del uenum.ppu
+ppcjvm -O2 -g tenum
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tenum
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tprop
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tprop
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tprop2
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tprop2
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tclassproptest
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tclassproptest
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tset3 -dproc
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tset3
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tset3
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tset3
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g taddset
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. taddset
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g taddsetint
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. taddsetint
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tformalpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tformalpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tvarpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tvarpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tpvar
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tpvar
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tpvardelphi
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tpvardelphi
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tpvarglobal
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tpvarglobal
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tpvarglobaldelphi
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tpvarglobaldelphi
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tvirtclmeth
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tvirtclmeth
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tdynarrec
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tdynarrec
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tconst
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tconst
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g twith
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. twith
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tint
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tint
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g ttrig
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. ttrig
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g ttrunc
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. ttrunc
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tset1
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tset1
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tabs
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tabs
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tintstr
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tintstr
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g trange1
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. trange1
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g trange2
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. trange2
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g trange3
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. trange3
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tdefpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tdefpara
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g getbit
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. getbit
+if %errorlevel% neq 0 exit /b %errorlevel%

tests/test/jvm/testall.sh

@@ -0,0 +1,96 @@
+#!/bin/bash
+
+set -ex
+
+ppcjvm -O2 -g unsupported
+ppcjvm -O2 -g testintf
+ppcjvm -O2 -g nested
+ppcjvm -O2 -g test
+javac -encoding utf-8 -cp ../../../rtl/units/jvm-java:. JavaClass.java
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. JavaClass
+ppcjvm -O2 -g sort
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. sort
+ppcjvm -O2 -g classmeth
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. classmeth
+ppcjvm -O2 -g classlist
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. classlist
+ppcjvm -O2 -g testansi
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. testansi
+ppcjvm -O2 -g tcnvstr1
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tcnvstr1
+ppcjvm -O2 -g tcnvstr3
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tcnvstr3
+ppcjvm -O2 -g testshort
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. testshort
+ppcjvm -O2 -g tarray2
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tarray2
+ppcjvm -O2 -g tarray3
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tarray3
+ppcjvm -O2 -g tnestproc
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tnestproc
+ppcjvm -O2 -g outpara
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. outpara
+ppcjvm -O2 -g tbytearrres
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tbytearrres
+ppcjvm -O2 -g forw
+ppcjvm -O2 -g tbyte
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tbyte
+rm -f uenum.ppu
+ppcjvm -O2 -g tenum
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tenum
+ppcjvm -O2 -g tprop
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tprop
+ppcjvm -O2 -g tprop2
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tprop2
+ppcjvm -O2 -g tclassproptest
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tclassproptest
+ppcjvm -O2 -g tset3 -dproc
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tset3
+ppcjvm -O2 -g tset3
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tset3
+ppcjvm -O2 -g taddset
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. taddset
+ppcjvm -O2 -g taddsetint
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. taddsetint
+ppcjvm -O2 -g tformalpara
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tformalpara
+ppcjvm -O2 -g tvarpara
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tvarpara
+ppcjvm -O2 -g tpvar
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tpvar
+ppcjvm -O2 -g tpvardelphi
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tpvardelphi
+ppcjvm -O2 -g tpvarglobal
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tpvarglobal
+ppcjvm -O2 -g tpvarglobaldelphi
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tpvarglobaldelphi
+ppcjvm -O2 -g tvirtclmeth
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tvirtclmeth
+ppcjvm -O2 -g tdynarrec
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tdynarrec
+ppcjvm -O2 -g tconst
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tconst
+ppcjvm -O2 -g twith
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. twith
+ppcjvm -O2 -g tint
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tint
+ppcjvm -O2 -g ttrig
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. ttrig
+ppcjvm -O2 -g ttrunc
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. ttrunc
+ppcjvm -O2 -g tset1
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tset1
+ppcjvm -O2 -g tabs
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tabs
+ppcjvm -O2 -g tintstr
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tintstr
+ppcjvm -O2 -g trange1
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. trange1
+ppcjvm -O2 -g trange2
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. trange2
+ppcjvm -O2 -g trange3
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. trange3
+ppcjvm -O2 -g tdefpara
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tdefpara
+ppcjvm -O2 -g getbit
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. getbit

tests/test/jvm/testansi.pp

@@ -0,0 +1,28 @@
+program testansi;
+
+{$mode delphi}
+
+procedure testansichars;
+const
+  ansiconst = #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31#32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63#64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80#81#82#83#84#85#86#87#88#89#90#91#92#93#94#95#96#97#98#99#100#101#102#103#104#105#106#107#108#109#110#111#112#113#114#115#116#117#118#119#120#121#122#123#124#125#126#127#128#129#130#131#132#133#134#135#136#137#138#139#140#141#142#143#144#145#146#147#148#149#150#151#152#153#154#155#156#157#158#159#160#161#162#163#164#165#166#167#168#169#170#171#172#173#174#175#176#177#178#179#180#181#182#183#184#185#186#187#188#189#190#191#192#193#194#195#196#197#198#199#200#201#202#203#204#205#206#207#208#209#210#211#212#213#214#215#216#217#218#219#220#221#222#223#224#225#226#227#228#229#230#231#232#233#234#235#236#237#238#239#240#241#242#243#244#245#246#247#248#249#250#251#252#253#254#255;
+var
+  s: ansistring;
+  i: longint;
+begin
+  s:=ansiconst;
+  for i:=1 to length(s) do
+    if ord(s[i])<>i-1 then
+      raise JLException.Create('wrong ascii contents');
+  setlength(s,10);
+  for i:=1 to length(s) do
+    begin
+      if ord(s[i])<>i-1 then
+        raise JLException.Create('wrong ascii contents 2');
+      if i>10 then
+        raise JLException.Create('ansistring too long');
+    end;
+end;
+
+begin
+  testansichars;
+end.

tests/test/jvm/testintf.pp

@@ -0,0 +1,78 @@
+{ %norun }
+
+{$mode objfpc}
+
+{$namespace org.freepascal.test}
+
+unit testintf;
+
+interface
+
+type
+  tinterface1 = interface
+    function test(l: longint): longint;
+  end;
+
+  tinterface2 = interface
+    const
+      iconst = longint(4);
+    function test(b: byte): longint;
+  end;
+
+  tinterface3 = interface(tinterface1,tinterface2)
+  end;
+
+  tinterface4 = interface
+    function intf4test(i: int64): longint;
+  end;
+
+  tintfclass = class(tinterface1,tinterface2,tinterface3)
+    constructor create;
+    function test(l: longint): longint;virtual;final;
+    function Test(b: byte): longint;virtual;final;
+    destructor destroy; override;
+  end;
+
+  tintfclass2 = class(tintfclass,tinterface4)
+    constructor create;
+    function intf4test(i: int64): longint;virtual;final;
+  end;
+
+implementation
+
+  uses
+    jdk15;
+
+  constructor tintfclass.create;
+    begin
+    end;
+
+  function tintfclass.Test(l: longint): longint;
+    begin
+      result:=l+1;
+    end;
+
+
+  function tintfclass.test(b: byte): longint;
+    begin
+      result:=b+2;
+    end;
+
+
+  destructor tintfclass.destroy;
+    begin
+      JLSystem.fout.println(555);
+    end;
+
+  constructor tintfclass2.create;
+    begin
+    end;
+
+
+  function tintfclass2.intf4test(i: int64): longint;
+    begin
+      result:=i div 12345;
+    end;
+
+
+end.

tests/test/jvm/testshort.pp

@@ -0,0 +1,28 @@
+program testshort;
+
+{$mode delphi}
+{$h-}
+
+procedure testansichars;
+const
+  shortconst = #0#1#2#3#4#5#6#7#8#9#10#11#12#13#14#15#16#17#18#19#20#21#22#23#24#25#26#27#28#29#30#31#32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50#51#52#53#54#55#56#57#58#59#60#61#62#63#64#65#66#67#68#69#70#71#72#73#74#75#76#77#78#79#80#81#82#83#84#85#86#87#88#89#90#91#92#93#94#95#96#97#98#99#100#101#102#103#104#105#106#107#108#109#110#111#112#113#114#115#116#117#118#119#120#121#122#123#124#125#126#127#128#129#130#131#132#133#134#135#136#137#138#139#140#141#142#143#144#145#146#147#148#149#150#151#152#153#154#155#156#157#158#159#160#161#162#163#164#165#166#167#168#169#170#171#172#173#174#175#176#177#178#179#180#181#182#183#184#185#186#187#188#189#190#191#192#193#194#195#196#197#198#199#200#201#202#203#204#205#206#207#208#209#210#211#212#213#214#215#216#217#218#219#220#221#222#223#224#225#226#227#228#229#230#231#232#233#234#235#236#237#238#239#240#241#242#243#244#245#246#247#248#249#250#251#252#253#254;
+var
+  s: shortstring;
+  i: longint;
+begin
+  setlength(s,0);
+  setlength(s,5);
+  s:=shortconst;
+  for i:=1 to length(s) do
+    if ord(s[i])<>i-1 then
+      raise JLException.Create('wrong ascii contents');
+  for i:=1 to length(s) do
+    s[i]:=chr(i);
+  for i:=1 to length(s) do
+    if ord(s[i])<>i then
+      raise JLException.Create('wrong ascii contents (2)');
+end;
+
+begin
+  testansichars;
+end.

tests/test/jvm/tformalpara.pp

@@ -0,0 +1,679 @@
+unit tformalpara;
+
+{$mode delphi}
+
+interface
+
+procedure main(args: array of string);
+
+implementation
+
+uses
+  jdk15;
+
+type
+  tc = class
+  end;
+
+procedure freeandnil(var obj);
+begin
+  obj:=nil;
+end;
+
+procedure test;
+var
+  c: tc;
+begin
+  c:=tc.create;
+  freeandnil(c);
+  if assigned(c) then
+    raise jlexception.create('help');
+end;
+
+type
+  tformalkind = (fboolean,fbyte,fsmallint,fcardinal,fint64,fchar,fwidechar,fsingle,fdouble,fsetint,fsetenum,frec,fshortstring,funicodestring,farrbyte,farrset);
+
+  tsetint = set of 30..40;
+  tsetenum = set of tformalkind;
+  tarrbyte = array[4..6] of byte;
+  tarrset = array[1..2] of tsetint;
+  trec = record
+    a: longint;
+    b: array[3..4] of ansistring;
+  end;
+
+const
+  cbooleanin: boolean = true;
+  cbytein: byte = 35;
+  csmallintin: smallint = 1234;
+  ccardinalin: cardinal = $1234567;
+  cint64in: int64 = $deadcafebabe;
+  ccharin: ansichar = 'S';
+  cwidecharin: widechar = 'U';
+  csinglein: single = 1234.5;
+  cdoublein: double = 1239643.75;
+  csetintin: tsetint = [36..39];
+  csetenumin: tsetenum = [fsmallint,fint64,funicodestring];
+  crecin: trec = (a:98765; b:('abc','def'));
+  cshortstringin: shortstring = 'greaT';
+  cunicodestringin: unicodestring = 'a bit longer!';
+  carrbytein: tarrbyte = (4,2,5);
+  carrsetin: tarrset = ([31,33,37],[]);
+  
+  cbooleanout: boolean = false;
+  cbyteout: byte = 128;
+  csmallintout: smallint = 4321;
+  ccardinalout: cardinal = $7654321;
+  cint64out: int64 = $B4B3154713;
+  ccharout: ansichar = 's';
+  cwidecharout: widechar = 'u';
+  csingleout: single = 4321.5;
+  cdoubleout: double = 9876543.75;
+  csetintout: tsetint = [31..36];
+  csetenumout: tsetenum = [fbyte];
+  crecout: trec = (a:4365246; b:('cbax','iiiiii'));
+  cshortstringout: shortstring = 'tiny';
+  cunicodestringout: unicodestring = 'yet another bit longer!';
+  carrbyteout: tarrbyte = (6,6,6);
+  carrsetout: tarrset = ([30,31],[33..38]);
+
+procedure testformalvar(var x; typ: tformalkind);
+  var
+    i: longint;
+  begin
+    case typ of
+      fboolean:
+        begin
+          if cbooleanin<>boolean(x) then
+            raise jlexception.create('boolean in');
+          x:=cbooleanout;
+        end;
+      fbyte:
+        begin
+          if cbytein<>byte(x) then
+            raise jlexception.create('byte in');
+          x:=cbyteout;
+        end;
+      fsmallint:
+        begin
+          if csmallintin<>smallint(x) then
+            raise jlexception.create('smallint in');
+          x:=csmallintout;
+        end;
+      fcardinal:
+        begin
+          if ccardinalin<>cardinal(x) then
+            raise jlexception.create('cardinal in');
+          x:=ccardinalout;
+        end;
+      fint64:
+        begin
+          if cint64in<>int64(x) then
+            raise jlexception.create('int64 in');
+          x:=cint64out;
+        end;
+      fchar:
+        begin
+          if ccharin<>char(x) then
+            raise jlexception.create('char in');
+          x:=ccharout;
+        end;
+      fwidechar:
+        begin
+          if cwidecharin<>widechar(x) then
+            raise jlexception.create('widechar in');
+          x:=cwidecharout;
+        end;
+      fsingle:
+        begin
+          if csinglein<>single(x) then
+            raise jlexception.create('single in');
+          x:=csingleout;
+        end;
+      fdouble:
+        begin
+          if cdoublein<>double(x) then
+            raise jlexception.create('double in');
+          x:=cdoubleout;
+        end;
+      fsetint:
+        begin
+          if csetintin<>tsetint(x) then
+            raise jlexception.create('setint in');
+          x:=csetintout;
+        end;
+      fsetenum:
+        begin
+          if csetenumin<>tsetenum(x) then
+            raise jlexception.create('setenum in');
+          x:=csetenumout;
+        end;
+      frec:
+        begin
+          if crecin.a<>trec(x).a then
+            raise jlexception.create('rec.a in');
+          if crecin.b[3]<>trec(x).b[3] then
+            raise jlexception.create('rec.b[3] in');
+          if crecin.b[4]<>trec(x).b[4] then
+            raise jlexception.create('rec.b[4] in');
+          x:=crecout;
+        end;
+      fshortstring:
+        begin
+          if cshortstringin<>shortstring(x) then
+            raise jlexception.create('shortstring in');
+          x:=cshortstringout;
+        end;
+      funicodestring:
+        begin
+          if cunicodestringin<>unicodestring(x) then
+            raise jlexception.create('unicodestring in');
+          x:=cunicodestringout;
+        end;
+      farrbyte:
+        begin
+          for i:=low(carrbytein) to high(carrbytein) do
+            if carrbytein[i]<>tarrbyte(x)[i] then
+              raise jlexception.create('arrbyte in');
+          x:=carrbyteout;
+        end;
+      farrset:
+        begin
+          for i:=low(carrsetin) to high(carrsetin) do
+            if carrsetin[i]<>tarrset(x)[i] then
+              raise jlexception.create('arrset in');
+          x:=carrsetout;
+        end;
+    end;
+  end;
+
+
+procedure testformalout(out x; typ: tformalkind);
+  var
+    i: longint;
+  begin
+    case typ of
+      fboolean:
+        begin
+          x:=cbooleanout;
+        end;
+      fbyte:
+        begin
+          x:=cbyteout;
+        end;
+      fsmallint:
+        begin
+          x:=csmallintout;
+        end;
+      fcardinal:
+        begin
+          x:=ccardinalout;
+        end;
+      fint64:
+        begin
+          x:=cint64out;
+        end;
+      fchar:
+        begin
+          x:=ccharout;
+        end;
+      fwidechar:
+        begin
+          x:=cwidecharout;
+        end;
+      fsingle:
+        begin
+          x:=csingleout;
+        end;
+      fdouble:
+        begin
+          x:=cdoubleout;
+        end;
+      fsetint:
+        begin
+          x:=csetintout;
+        end;
+      fsetenum:
+        begin
+          x:=csetenumout;
+        end;
+      frec:
+        begin
+        { fpc only decreases the reference, it doesn't finalize/init with empty/nil
+          if ''<>trec(x).b[3] then
+            raise jlexception.create('out rec.b[3] in');
+          if ''<>trec(x).b[4] then
+            raise jlexception.create('out rec.b[4] in');
+        }
+          x:=crecout;
+        end;
+      fshortstring:
+        begin
+          x:=cshortstringout;
+        end;
+      funicodestring:
+        begin
+        { fpc only decreases the reference, it doesn't finalize/init with           if ''<>unicodestring(x) then
+            raise jlexception.create('out unicodestring in');
+        }
+          x:=cunicodestringout;
+        end;
+      farrbyte:
+        begin
+          x:=carrbyteout;
+        end;
+      farrset:
+        begin
+          x:=carrsetout;
+        end;
+    end;
+  end;
+
+
+procedure testformalconst(const x; typ: tformalkind);
+  var
+    i: longint;
+  begin
+    case typ of
+      fboolean:
+        begin
+          if cbooleanin<>boolean(x) then
+            raise jlexception.create('const boolean in');
+        end;
+      fbyte:
+        begin
+          if cbytein<>byte(x) then
+            raise jlexception.create('const byte in');
+        end;
+      fsmallint:
+        begin
+          if csmallintin<>smallint(x) then
+            raise jlexception.create('const smallint in');
+        end;
+      fcardinal:
+        begin
+          if ccardinalin<>cardinal(x) then
+            raise jlexception.create('const cardinal in');
+        end;
+      fint64:
+        begin
+          if cint64in<>int64(x) then
+            raise jlexception.create('const int64 in');
+        end;
+      fchar:
+        begin
+          if ccharin<>char(x) then
+            raise jlexception.create('const char in');
+        end;
+      fwidechar:
+        begin
+          if cwidecharin<>widechar(x) then
+            raise jlexception.create('const widechar in');
+        end;
+      fsingle:
+        begin
+          if csinglein<>single(x) then
+            raise jlexception.create('const single in');
+        end;
+      fdouble:
+        begin
+          if cdoublein<>double(x) then
+            raise jlexception.create('const double in');
+        end;
+      fsetint:
+        begin
+          if csetintin<>tsetint(x) then
+            raise jlexception.create('const setint in');
+        end;
+      fsetenum:
+        begin
+          if csetenumin<>tsetenum(x) then
+            raise jlexception.create('const setenum in');
+        end;
+      frec:
+        begin
+          if crecin.a<>trec(x).a then
+            raise jlexception.create('const rec.a in');
+          if crecin.b[3]<>trec(x).b[3] then
+            raise jlexception.create('const rec.b[3] in');
+          if crecin.b[4]<>trec(x).b[4] then
+            raise jlexception.create('const rec.b[4] in');
+        end;
+      fshortstring:
+        begin
+          if cshortstringin<>shortstring(x) then
+            raise jlexception.create('const shortstring in');
+        end;
+      funicodestring:
+        begin
+          if cunicodestringin<>unicodestring(x) then
+            raise jlexception.create('const unicodestring in');
+        end;
+      farrbyte:
+        begin
+          for i:=low(carrbytein) to high(carrbytein) do
+            if carrbytein[i]<>tarrbyte(x)[i] then
+              raise jlexception.create('const arrbyte in');
+        end;
+      farrset:
+        begin
+          for i:=low(carrsetin) to high(carrsetin) do
+            if carrsetin[i]<>tarrset(x)[i] then
+              raise jlexception.create('const arrset in');
+        end;
+    end;
+  end;
+
+
+procedure testformalvars;
+  var
+    vboolean: boolean;
+    vbyte: byte;
+    vsmallint: smallint;
+    vcardinal: cardinal;
+    vint64: int64;
+    vchar: char;
+    vwidechar: widechar;
+    vsingle: single;
+    vdouble: double;
+    vsetint: tsetint;
+    vsetenum: tsetenum;
+    vrec: trec;
+    vshortstring: shortstring;
+    vunicodestring: unicodestring;
+    varrbyte: tarrbyte;
+    varrset: tarrset;
+    i: longint;
+  begin
+    vboolean:=cbooleanin;
+    testformalvar(vboolean,fboolean);
+    if vboolean<>cbooleanout then
+      raise jlexception.create('boolean out');
+    vbyte:=cbytein;
+    testformalvar(vbyte,fbyte);
+    if vbyte<>cbyteout then
+      raise jlexception.create('byte out');
+    vsmallint:=csmallintin;
+    testformalvar(vsmallint,fsmallint);
+    if vsmallint<>csmallintout then
+      raise jlexception.create('smallint out');
+    vunicodestring:=widechar(csmallintin);
+    testformalvar(smallint(vunicodestring[1]),fsmallint);
+    if smallint(vunicodestring[1])<>csmallintout then
+      raise jlexception.create('stringsmallint out');
+    vcardinal:=ccardinalin;
+    testformalvar(vcardinal,fcardinal);
+    if vcardinal<>ccardinalout then
+      raise jlexception.create('cardinal out');
+    vint64:=cint64in;
+    testformalvar(vint64,fint64);
+    if vint64<>cint64out then
+      raise jlexception.create('int64 out');
+    vchar:=ccharin;
+    testformalvar(vchar,fchar);
+    if vchar<>ccharout then
+      raise jlexception.create('char out');
+    vwidechar:=cwidecharin;
+    testformalvar(vwidechar,fwidechar);
+    if vwidechar<>cwidecharout then
+      raise jlexception.create('widechar out');
+    vunicodestring:=cwidecharin;
+    testformalvar(vunicodestring[1],fwidechar);
+    if vunicodestring[1]<>cwidecharout then
+      raise jlexception.create('stringwidechar out');
+    vsingle:=csinglein;
+    testformalvar(vsingle,fsingle);
+    if vsingle<>csingleout then
+      raise jlexception.create('single out');
+    vdouble:=cdoublein;
+    testformalvar(vdouble,fdouble);
+    if vdouble<>cdoubleout then
+      raise jlexception.create('double out');
+    vsetint:=csetintin;
+    testformalvar(vsetint,fsetint);
+    if vsetint<>csetintout then
+      raise jlexception.create('setint out');
+    vsetenum:=csetenumin;
+    testformalvar(vsetenum,fsetenum);
+    if vsetenum<>csetenumout then
+      raise jlexception.create('setenum out');
+    vrec:=crecin;
+    testformalvar(vrec,frec);
+    if crecout.a<>vrec.a then
+      raise jlexception.create('rec.a out');
+    if crecout.b[3]<>vrec.b[3] then
+      raise jlexception.create('rec.b[3] out');
+    if crecout.b[4]<>vrec.b[4] then
+      raise jlexception.create('rec.b[4] out');
+    vshortstring:=cshortstringin;
+    testformalvar(vshortstring,fshortstring);
+    if vshortstring<>cshortstringout then
+      raise jlexception.create('shortstring out');
+    vunicodestring:=cunicodestringin;
+    testformalvar(vunicodestring,funicodestring);
+    if vunicodestring<>cunicodestringout then
+      raise jlexception.create('unicodestring out');
+    varrbyte:=carrbytein;
+    testformalvar(varrbyte,farrbyte);
+    for i:=low(carrbyteout) to high(carrbyteout) do
+      if carrbyteout[i]<>varrbyte[i] then
+        raise jlexception.create('arrbyte out');
+    varrset:=carrsetin;
+    testformalvar(varrset,farrset);
+    for i:=low(carrsetout) to high(carrsetout) do
+      if varrset[i]<>carrsetout[i] then
+        raise jlexception.create('arrset out');
+  end;
+
+
+procedure testformalouts;
+  var
+    vboolean: boolean;
+    vbyte: byte;
+    vsmallint: smallint;
+    vcardinal: cardinal;
+    vint64: int64;
+    vchar: char;
+    vwidechar: widechar;
+    vsingle: single;
+    vdouble: double;
+    vsetint: tsetint;
+    vsetenum: tsetenum;
+    vrec: trec;
+    vshortstring: shortstring;
+    vunicodestring: unicodestring;
+    varrbyte: tarrbyte;
+    varrset: tarrset;
+    i: longint;
+  begin
+    vboolean:=cbooleanin;
+    testformalout(vboolean,fboolean);
+    if vboolean<>cbooleanout then
+      raise jlexception.create('out boolean out');
+    vbyte:=cbytein;
+    testformalout(vbyte,fbyte);
+    if vbyte<>cbyteout then
+      raise jlexception.create('out byte out');
+    vsmallint:=csmallintin;
+    testformalout(vsmallint,fsmallint);
+    if vsmallint<>csmallintout then
+      raise jlexception.create('out smallint out');
+    vunicodestring:=widechar(csmallintin);
+    testformalout(smallint(vunicodestring[1]),fsmallint);
+    if smallint(vunicodestring[1])<>csmallintout then
+      raise jlexception.create('out stringsmallint out');
+    vcardinal:=ccardinalin;
+    testformalout(vcardinal,fcardinal);
+    if vcardinal<>ccardinalout then
+      raise jlexception.create('out cardinal out');
+    vint64:=cint64in;
+    testformalout(vint64,fint64);
+    if vint64<>cint64out then
+      raise jlexception.create('out int64 out');
+    vchar:=ccharin;
+    testformalout(vchar,fchar);
+    if vchar<>ccharout then
+      raise jlexception.create('out char out');
+    vwidechar:=cwidecharin;
+    testformalout(vwidechar,fwidechar);
+    if vwidechar<>cwidecharout then
+      raise jlexception.create('out widechar out');
+    vunicodestring:=cwidecharin;
+    testformalout(vunicodestring[1],fwidechar);
+    if vunicodestring[1]<>cwidecharout then
+      raise jlexception.create('out stringwidechar out');
+    vsingle:=csinglein;
+    testformalout(vsingle,fsingle);
+    if vsingle<>csingleout then
+      raise jlexception.create('out single out');
+    vdouble:=cdoublein;
+    testformalout(vdouble,fdouble);
+    if vdouble<>cdoubleout then
+      raise jlexception.create('out double out');
+    vsetint:=csetintin;
+    testformalout(vsetint,fsetint);
+    if vsetint<>csetintout then
+      raise jlexception.create('out setint out');
+    vsetenum:=csetenumin;
+    testformalout(vsetenum,fsetenum);
+    if vsetenum<>csetenumout then
+      raise jlexception.create('out setenum out');
+    vrec:=crecin;
+    testformalout(vrec,frec);
+    if crecout.a<>vrec.a then
+      raise jlexception.create('out rec.a out');
+    if crecout.b[3]<>vrec.b[3] then
+      raise jlexception.create('out rec.b[3] out');
+    if crecout.b[4]<>vrec.b[4] then
+      raise jlexception.create('out rec.b[4] out');
+    vshortstring:=cshortstringin;
+    testformalout(vshortstring,fshortstring);
+    if vshortstring<>cshortstringout then
+      raise jlexception.create('out shortstring out');
+    vunicodestring:=cunicodestringin;
+    testformalout(vunicodestring,funicodestring);
+    if vunicodestring<>cunicodestringout then
+      raise jlexception.create('out unicodestring out');
+    varrbyte:=carrbytein;
+    testformalout(varrbyte,farrbyte);
+    for i:=low(carrbyteout) to high(carrbyteout) do
+      if carrbyteout[i]<>varrbyte[i] then
+        raise jlexception.create('out arrbyte out');
+    varrset:=carrsetin;
+    testformalout(varrset,farrset);
+    for i:=low(carrsetout) to high(carrsetout) do
+      if varrset[i]<>carrsetout[i] then
+        raise jlexception.create('out arrset out');
+  end;
+
+
+procedure testformalconsts;
+  var
+    vboolean: boolean;
+    vbyte: byte;
+    vsmallint: smallint;
+    vcardinal: cardinal;
+    vint64: int64;
+    vchar: char;
+    vwidechar: widechar;
+    vsingle: single;
+    vdouble: double;
+    vsetint: tsetint;
+    vsetenum: tsetenum;
+    vrec: trec;
+    vshortstring: shortstring;
+    vunicodestring: unicodestring;
+    varrbyte: tarrbyte;
+    varrset: tarrset;
+    i: longint;
+  begin
+    vboolean:=cbooleanin;
+    testformalconst(vboolean,fboolean);
+    if vboolean<>cbooleanin then
+      raise jlexception.create('const boolean out');
+    vbyte:=cbytein;
+    testformalconst(vbyte,fbyte);
+    if vbyte<>cbytein then
+      raise jlexception.create('const byte out');
+    vsmallint:=csmallintin;
+    testformalconst(vsmallint,fsmallint);
+    if vsmallint<>csmallintin then
+      raise jlexception.create('const smallint out');
+    vunicodestring:=widechar(csmallintin);
+    testformalconst(smallint(vunicodestring[1]),fsmallint);
+    if smallint(vunicodestring[1])<>csmallintin then
+      raise jlexception.create('const stringsmallint out');
+    vcardinal:=ccardinalin;
+    testformalconst(vcardinal,fcardinal);
+    if vcardinal<>ccardinalin then
+      raise jlexception.create('const cardinal out');
+    vint64:=cint64in;
+    testformalconst(vint64,fint64);
+    if vint64<>cint64in then
+      raise jlexception.create('const int64 out');
+    vchar:=ccharin;
+    testformalconst(vchar,fchar);
+    if vchar<>ccharin then
+      raise jlexception.create('const char out');
+    vwidechar:=cwidecharin;
+    testformalconst(vwidechar,fwidechar);
+    if vwidechar<>cwidecharin then
+      raise jlexception.create('const widechar out');
+    vunicodestring:=cwidecharin;
+    testformalconst(vunicodestring[1],fwidechar);
+    if vunicodestring[1]<>cwidecharin then
+      raise jlexception.create('const stringwidechar out');
+    vsingle:=csinglein;
+    testformalconst(vsingle,fsingle);
+    if vsingle<>csinglein then
+      raise jlexception.create('const single out');
+    vdouble:=cdoublein;
+    testformalconst(vdouble,fdouble);
+    if vdouble<>cdoublein then
+      raise jlexception.create('const double out');
+    vsetint:=csetintin;
+    testformalconst(vsetint,fsetint);
+    if vsetint<>csetintin then
+      raise jlexception.create('const setint out');
+    vsetenum:=csetenumin;
+    testformalconst(vsetenum,fsetenum);
+    if vsetenum<>csetenumin then
+      raise jlexception.create('const setenum out');
+    vrec:=crecin;
+    testformalconst(vrec,frec);
+    if crecin.a<>vrec.a then
+      raise jlexception.create('const rec.a out');
+    if crecin.b[3]<>vrec.b[3] then
+      raise jlexception.create('const rec.b[3] out');
+    if crecin.b[4]<>vrec.b[4] then
+      raise jlexception.create('const rec.b[4] out');
+    vshortstring:=cshortstringin;
+    testformalconst(vshortstring,fshortstring);
+    if vshortstring<>cshortstringin then
+      raise jlexception.create('const shortstring out');
+    vunicodestring:=cunicodestringin;
+    testformalconst(vunicodestring,funicodestring);
+    if vunicodestring<>cunicodestringin then
+      raise jlexception.create('const unicodestring out');
+    varrbyte:=carrbytein;
+    testformalconst(varrbyte,farrbyte);
+    for i:=low(carrbytein) to high(carrbytein) do
+      if carrbytein[i]<>varrbyte[i] then
+        raise jlexception.create('const arrbyte out');
+    varrset:=carrsetin;
+    testformalconst(varrset,farrset);
+    for i:=low(carrsetin) to high(carrsetin) do
+      if varrset[i]<>carrsetin[i] then
+        raise jlexception.create('const arrset out');
+  end;
+
+
+procedure main(args: array of string);
+begin
+  test;
+  testformalvars;
+  testformalouts;
+  testformalconsts;
+end;
+
+end.

tests/test/jvm/tint.pp

@@ -0,0 +1,236 @@
+{ this tests the int routine }
+{ Contrary to TP, int can be used in the constant section,
+  just like in Delphi }
+program tint;
+
+{$modeswitch exceptions}
+
+uses
+  jdk15;
+
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
+{$macro on}
+{$define writeln:=JLSystem.fout.println}
+{$define write:=JLSystem.fout.print}
+
+const
+  INT_RESULT_ONE = 1234;
+  INT_VALUE_ONE = 1234.5678;
+  INT_RESULT_CONST_ONE = Int(INT_VALUE_ONE);
+  INT_RESULT_TWO = -1234;
+  INT_VALUE_TWO = -1234.5678;
+  INT_RESULT_CONST_TWO = Int(INT_VALUE_TWO);
+
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+//    halt(1);
+    raise JLException.create('boo!');
+  end;
+
+procedure test_int_real;
+var
+ r: real;
+ _success : boolean;
+Begin
+ Write('Int() real testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_int_single;
+var
+ r: single;
+ _success : boolean;
+Begin
+ Write('Int() single testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_int_double;
+var
+ r: double;
+ _success : boolean;
+Begin
+ Write('Int() double testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+{$ifndef SKIP_CURRENCY_TEST}
+procedure test_int_currency;
+var
+ r: currency;
+ _success : boolean;
+Begin
+ Write('Int() currency testing...');
+ _success := true;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_ONE then
+   _success:=false;
+
+ if not _success then
+   fail;
+
+ if Int(INT_VALUE_ONE)<>INT_RESULT_ONE then
+   _success:=false;
+ r:=INT_VALUE_ONE;
+ if Int(r)<>INT_RESULT_CONST_ONE then
+   _success := false;
+ r:=INT_VALUE_ONE;
+ r:=Int(r);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+ r:=Int(INT_VALUE_ONE);
+ if r<>INT_RESULT_ONE then
+   _success:=false;
+
+ if not _success then
+   fail;
+
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_TWO then
+   _success:=false;
+ if Int(INT_VALUE_TWO)<>INT_RESULT_TWO then
+   _success:=false;
+ r:=INT_VALUE_TWO;
+ if Int(r)<>INT_RESULT_CONST_TWO then
+   _success := false;
+ r:=INT_VALUE_TWO;
+ r:=Int(r);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+ r:=Int(INT_VALUE_TWO);
+ if r<>INT_RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+{$endif SKIP_CURRENCY_TEST}
+
+Begin
+  test_int_real;
+  test_int_double;
+  test_int_single;
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
+  test_int_currency;
+{$endif SKIP_CURRENCY_TEST}
+end.

tests/test/jvm/tintstr.pp

@@ -0,0 +1,139 @@
+program tintstr;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+{$endif}
+
+var
+  l: longint;
+  c: cardinal;
+  i: int64;
+  q: qword;
+
+type
+  tr1 =  packed record
+    s: string[1];
+    b1,b2,b3,b4: byte;
+  end;
+procedure ts1(const res1, res2, res3, res4: string);
+var
+  r: tr1;
+begin
+  with r do
+    begin
+      b1:=0;
+      b2:=0;
+      b3:=0;
+      b4:=0;
+      str(l,s);
+      if (res1<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(1);
+
+      str(c,s);
+      if (res2<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(2);
+
+      str(i,s);
+      if (res3<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(3);
+
+      str(q,s);
+      if (res4<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(4);
+    end;
+end;
+
+
+type
+  tr2 = packed record
+    s: string[3];
+    b1,b2,b3,b4: byte;
+  end;
+
+procedure ts3(const res1, res2, res3, res4: string);
+var
+  r: tr2;
+begin
+  with r do
+    begin
+      b1:=0;
+      b2:=0;
+      b3:=0;
+      b4:=0;
+      str(l,s);
+      if (res1<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(1);
+
+      str(c,s);
+      if (res2<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(2);
+
+      str(i,s);
+      if (res3<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(3);
+
+      str(q,s);
+      if (res4<>s) or
+         (b1<>0) or
+         (b2<>0) or
+         (b3<>0) or
+         (b4<>0) then
+        halt(4);
+    end;
+end;
+
+var
+  a: ansistring;
+  u: unicodestring;
+  xl: longint;
+begin
+  l:=high(longint);
+  c:=high(cardinal);
+  i:=high(int64);
+  q:=high(qword);
+  ts1('2','4','9','1');
+  ts3('214','429','922','184');
+  l:=low(longint)+1;
+  c:=high(cardinal)-1;
+  i:=low(int64)+1;
+  q:=high(qword)-1;
+  ts1('-','4','-','1');
+  ts3('-21','429','-92','184');
+(*
+  str(1,a);
+  str(2,u);
+*)
+end.

tests/test/jvm/tnestproc.pp

@@ -0,0 +1,40 @@
+program tnestproc;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+procedure outer(var para: byte);
+  const xxx: longint = 5;
+  var
+    a: longint;
+
+  procedure inner;
+    begin
+      if a<>1 then
+        raise JLException.Create('a1');
+      if para<>2 then
+        raise JLException.Create('para1');
+      a:=2;
+      para:=3;
+    end;
+
+  begin
+    a:=1;
+    inner;
+    if a<>2 then
+      raise JLException.Create('a2');
+    if para<>3 then
+      raise JLException.Create('para2');
+  end;
+
+var
+  x: record end;
+  y: byte;
+begin
+  y:=2;
+  outer(y);
+  if y<>3 then
+    raise JLException.Create('para3');
+end.

tests/test/jvm/tprop.pp

@@ -0,0 +1,43 @@
+program tprop;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  tc = class
+   strict private
+    fvalue: longint;
+    function getit: longint;
+    procedure setit(l: longint);
+   public
+    property value: longint read getit write setit;
+    constructor create(l: longint);
+  end;
+
+  constructor tc.create(l: longint);
+    begin
+      fvalue:=l;
+    end;
+
+
+  function tc.getit: longint;
+    begin
+      result:=fvalue;
+    end;
+
+
+  procedure tc.setit(l: longint);
+    begin
+      fvalue:=l;
+    end;
+
+var
+  c: tc;
+begin
+  c:=tc.create(5);
+  jlsystem.fout.println(c.value);
+  c.value:=6;
+  jlsystem.fout.println(c.value);
+end.

tests/test/jvm/tprop2.pp

@@ -0,0 +1,46 @@
+program tprop2;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+ tpropclass1 = class
+ strict private
+   fx : integer;
+ public
+   procedure Reset; virtual;
+
+ end;
+
+ tpropclass2 = class(tpropclass1)
+ strict private
+   fx : integer;
+ public
+   procedure Reset; override;
+   property x : integer read fx write fx;
+ end;
+
+procedure tpropclass1.Reset;
+begin
+ fx := 777;
+end;
+
+procedure tpropclass2.Reset;
+begin
+ fx := 888;
+end;
+
+var
+ t : tpropclass2;
+begin
+  t := tpropclass2.create;
+  t.reset;
+  if t.x<>888 then
+    raise jlexception.create('error 1');
+  t.x:=555;
+  if t.x<>555 then
+    raise jlexception.create('error 1');
+end.
+  

tests/test/jvm/tpvar.pp

@@ -0,0 +1,103 @@
+program tpvar;
+
+{$mode objfpc}
+
+uses
+  jdk15;
+
+type
+  tmprec = record
+    b: byte;
+  end;
+
+  tmethodclass = class
+    l: longint;
+    procedure test(x: longint; w: word; r: tmprec; var ro: tmprec);
+    class procedure classproc(b: longint);
+    class procedure callclassproc;
+  end;
+
+  tmethodclass2 = class(tmethodclass)
+    class procedure classproc(b: longint);
+  end;
+
+  tmypvar = procedure(x: longint; w: word; r: tmprec; var ro: tmprec) of object;
+
+
+  procedure tmethodclass.test(x: longint; w: word; r: tmprec; var ro: tmprec);
+    begin
+      jlsystem.fout.print('l: ');
+      jlsystem.fout.println(l);
+      jlsystem.fout.print('x: ');
+      jlsystem.fout.println(x);
+      jlsystem.fout.print('w: ');
+      jlsystem.fout.println(w);
+      jlsystem.fout.print('r.b: ');
+      jlsystem.fout.println(r.b);
+      jlsystem.fout.print('ro.b: ');
+      jlsystem.fout.println(ro.b);
+      if l<>6 then
+        raise jlexception.create('l wrong on input');
+      if x<>1 then
+        raise jlexception.create('x wrong on input');
+      if w<>$ffff then
+        raise jlexception.create('w wrong on input');
+      if r.b<>21 then
+        raise jlexception.create('r.b wrong on input');
+      if ro.b<>42 then
+        raise jlexception.create('ro.b wrong on input');
+      r.b:=123;
+      ro.b:=123;
+    end;
+
+
+  class procedure tmethodclass.classproc(b: longint);
+    begin
+      jlsystem.fout.println('tmethodclass.classproc');
+    end;
+
+  class procedure tmethodclass.callclassproc;
+    type
+      pv = procedure(l: longint) of object;
+    var
+      v: pv;
+    begin
+      v:=@classproc;
+      v(3);
+    end;
+
+
+
+  class procedure tmethodclass2.classproc(b: longint);
+    begin
+      jlsystem.fout.println('tmethodclass2.classproc');
+    end;
+
+type
+  tcc = class of tmethodclass;
+
+var
+  mypvar: tmypvar;
+  c: tmethodclass;
+  r, ro: tmprec;
+  cc: tcc;
+begin
+  r.b:=21;
+  ro.b:=42;
+  c:=tmethodclass2.create;
+  c.l:=6;
+  mypvar:[email protected];
+  mypvar(1,$ffff,r,ro);
+  if r.b<>21 then
+    raise jlexception.create('r changed');
+  if ro.b<>123 then
+    raise jlexception.create('ro not changed');
+  c.free;
+
+  tmethodclass.callclassproc;
+  tmethodclass2.callclassproc;
+  cc:=tmethodclass;
+  cc.callclassproc;
+  cc:=tmethodclass2;
+  cc.callclassproc;
+end.

tests/test/jvm/tpvardelphi.pp

@@ -0,0 +1,97 @@
+program tpvardelphi;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  tmprec = record
+    b: byte;
+  end;
+
+  tmethodclass = class
+    l: longint;
+    procedure test(x: longint; w: word; r: tmprec; var ro: tmprec);
+    procedure shorttest(b: byte);
+    procedure shorttest2(b: byte);
+  end;
+
+  tmypvar = procedure(x: longint; w: word; r: tmprec; var ro: tmprec) of object;
+  tmyshortpvar = procedure(b: byte) of object;
+
+
+  procedure tmethodclass.test(x: longint; w: word; r: tmprec; var ro: tmprec);
+    begin
+      jlsystem.fout.print('l: ');
+      jlsystem.fout.println(l);
+      jlsystem.fout.print('x: ');
+      jlsystem.fout.println(x);
+      jlsystem.fout.print('w: ');
+      jlsystem.fout.println(w);
+      jlsystem.fout.print('r.b: ');
+      jlsystem.fout.println(r.b);
+      jlsystem.fout.print('ro.b: ');
+      jlsystem.fout.println(ro.b);
+      if l<>6 then
+        raise jlexception.create('l wrong on input');
+      if x<>1 then
+        raise jlexception.create('x wrong on input');
+      if w<>$ffff then
+        raise jlexception.create('w wrong on input');
+      if r.b<>21 then
+        raise jlexception.create('r.b wrong on input');
+      if ro.b<>42 then
+        raise jlexception.create('ro.b wrong on input');
+      r.b:=123;
+      ro.b:=123;
+    end;
+
+  procedure tmethodclass.shorttest(b: byte);
+    begin
+      if b<>129 then
+        raise jlexception.create('shorttest b wrong');
+      if l<>7 then
+        raise jlexception.create('shorttest l wrong');
+    end;
+
+  procedure tmethodclass.shorttest2(b: byte);
+    begin
+      if b<>130 then
+        raise jlexception.create('shorttest2 b wrong');
+      if l<>6 then
+        raise jlexception.create('shorttest l wrong');
+    end;
+
+var
+  mypvar, mypvar2: tmypvar;
+  c,c2: tmethodclass;
+  r, ro: tmprec;
+  meth: tmethod;
+  shortpvar1,shortpvar2: tmyshortpvar;
+begin
+  r.b:=21;
+  ro.b:=42;
+  c:=tmethodclass.create;
+  c.l:=6;
+  mypvar:=c.test;
+  meth:=tmethod(mypvar);
+  mypvar:=tmypvar(meth);
+  mypvar(1,$ffff,r,ro);
+  if r.b<>21 then
+    raise jlexception.create('r changed');
+  if ro.b<>123 then
+    raise jlexception.create('ro not changed');
+
+  c2:=tmethodclass.create;
+  c2.l:=7;
+
+  shortpvar1:=c.shorttest;
+  shortpvar2:=c2.shorttest2;
+  { should only copy the procedure pointer, not the instance ->
+    instance.l=6, expected parameter = 130 }
+  @shortpvar1:=@shortpvar2;
+  shortpvar1(130);
+
+  c.free;
+end.

tests/test/jvm/tpvarglobal.pp

@@ -0,0 +1,53 @@
+program tpvarglobal;
+
+{$mode objfpc}
+
+uses
+  jdk15;
+
+type
+  tmprec = record
+    b: byte;
+  end;
+
+  tmypvar = function(x: longint; w: word; r: tmprec; var ro: tmprec): shortstring;
+
+  function test(x: longint; w: word; r: tmprec; var ro: tmprec): shortstring;
+    begin
+      jlsystem.fout.print('x: ');
+      jlsystem.fout.println(x);
+      jlsystem.fout.print('w: ');
+      jlsystem.fout.println(w);
+      jlsystem.fout.print('r.b: ');
+      jlsystem.fout.println(r.b);
+      jlsystem.fout.print('ro.b: ');
+      jlsystem.fout.println(ro.b);
+      if x<>1 then
+        raise jlexception.create('x wrong on input');
+      if w<>$ffff then
+        raise jlexception.create('w wrong on input');
+      if r.b<>21 then
+        raise jlexception.create('r.b wrong on input');
+      if ro.b<>42 then
+        raise jlexception.create('ro.b wrong on input');
+      r.b:=123;
+      ro.b:=123;
+      result:='abc';
+    end;
+
+var
+  mypvar: tmypvar;
+  r, ro: tmprec;
+  res: shortstring;
+begin
+  r.b:=21;
+  ro.b:=42;
+  mypvar:=@test;
+  res:=mypvar(1,$ffff,r,ro);
+  if r.b<>21 then
+    raise jlexception.create('r changed');
+  if ro.b<>123 then
+    raise jlexception.create('ro not changed');
+  if res<>'abc' then
+    raise jlexception.create('result wrong');
+end.

tests/test/jvm/tpvarglobaldelphi.pp

@@ -0,0 +1,53 @@
+program tpvarglobaldelphi;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  tmprec = record
+    b: byte;
+  end;
+
+  tmypvar = function(x: longint; w: word; r: tmprec; var ro: tmprec): shortstring;
+
+  function test(x: longint; w: word; r: tmprec; var ro: tmprec): shortstring;
+    begin
+      jlsystem.fout.print('x: ');
+      jlsystem.fout.println(x);
+      jlsystem.fout.print('w: ');
+      jlsystem.fout.println(w);
+      jlsystem.fout.print('r.b: ');
+      jlsystem.fout.println(r.b);
+      jlsystem.fout.print('ro.b: ');
+      jlsystem.fout.println(ro.b);
+      if x<>1 then
+        raise jlexception.create('x wrong on input');
+      if w<>$ffff then
+        raise jlexception.create('w wrong on input');
+      if r.b<>21 then
+        raise jlexception.create('r.b wrong on input');
+      if ro.b<>42 then
+        raise jlexception.create('ro.b wrong on input');
+      r.b:=123;
+      ro.b:=123;
+      result:='abc';
+    end;
+
+var
+  mypvar: tmypvar;
+  r, ro: tmprec;
+  res: shortstring;
+begin
+  r.b:=21;
+  ro.b:=42;
+  mypvar:=test;
+  res:=mypvar(1,$ffff,r,ro);
+  if r.b<>21 then
+    raise jlexception.create('r changed');
+  if ro.b<>123 then
+    raise jlexception.create('ro not changed');
+  if res<>'abc' then
+    raise jlexception.create('result wrong');
+end.

tests/test/jvm/trange1.pp

@@ -0,0 +1,255 @@
+program trange1;
+
+{ %VERSION=1.1 }
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+
+type
+  qprinttype = int64;
+
+{$else}
+uses
+  SysUtils;
+
+type
+  qprinttype = qword;
+{$endif}
+
+
+{$ifndef fpc}
+type
+  qword=int64;
+  dword=cardinal;
+{$endif}
+
+var
+  error: boolean;
+
+{$r+}
+function testlongint_int64(i: int64; shouldfail: boolean): boolean;
+var
+  l: longint;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testlongint_qword(i: qword; shouldfail: boolean): boolean;
+var
+  l: longint;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testdword_int64(i: int64; shouldfail: boolean): boolean;
+var
+  l: dword;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+function testdword_qword(i: qword; shouldfail: boolean): boolean;
+var
+  l: dword;
+  failed: boolean;
+begin
+  failed := false;
+  try
+    l := i;
+  except
+    failed := true;
+  end;
+  result := failed = shouldfail;
+  error := error or not result;
+end;
+
+{$r-}
+
+var
+  i: int64;
+  q: qword;
+begin
+  error := false;
+{ *********************** int64 to longint ********************* }
+  writeln('int64 to longint');
+  i := $ffffffffffffffff;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test1 failed');
+  i := i and $ffffffff00000000;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test2 failed');
+  inc(i);
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test3 failed');
+  i := $ffffffff80000000;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test4 failed');
+  i := $80000000;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test5 failed');
+  dec(i);
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test6 failed');
+  i := $ffffffff;
+  writeln(i);
+  if not testlongint_int64(i,true) then
+    writeln('test7 failed');
+  i := 0;
+  writeln(i);
+  if not testlongint_int64(i,false) then
+    writeln('test8 failed');
+
+{ *********************** qword to longint ********************* }
+  writeln;
+  writeln('qword to longint');
+  q := qword($ffffffffffffffff);
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test1 failed');
+  q := q and $ffffffff00000000;
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test2 failed');
+  inc(q);
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test3 failed');
+  q := $ffffffff80000000;
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test4 failed');
+  q := $80000000;
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test5 failed');
+  dec(q);
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,false) then
+    writeln('test6 failed');
+  q := $ffffffff;
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,true) then
+    writeln('test7 failed');
+  q := 0;
+  writeln(qprinttype(q));
+  if not testlongint_qword(q,false) then
+    writeln('test8 failed');
+
+{ *********************** int64 to dword ********************* }
+  writeln;
+  writeln('int64 to dword');
+  i := $ffffffffffffffff;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test1 failed');
+  i := i and $ffffffff00000000;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test2 failed');
+  inc(i);
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test3 failed');
+  i := $ffffffff80000000;
+  writeln(i);
+  if not testdword_int64(i,true) then
+    writeln('test4 failed');
+  i := $80000000;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test5 failed');
+  dec(i);
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test6 failed');
+  i := $ffffffff;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test7 failed');
+  i := 0;
+  writeln(i);
+  if not testdword_int64(i,false) then
+    writeln('test8 failed');
+
+{ *********************** qword to dword ********************* }
+  writeln;
+  writeln('qword to dword');
+  q := $ffffffffffffffff;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,true) then
+    writeln('test1 failed');
+  q := q and $ffffffff00000000;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,true) then
+    writeln('test2 failed');
+  inc(q);
+  writeln(qprinttype(q));
+  if not testdword_qword(q,true) then
+    writeln('test3 failed');
+  q := $ffffffff80000000;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,true) then
+    writeln('test4 failed');
+  q := $80000000;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,false) then
+    writeln('test5 failed');
+  dec(q);
+  writeln(qprinttype(q));
+  if not testdword_qword(q,false) then
+    writeln('test6 failed');
+  q := $ffffffff;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,false) then
+    writeln('test7 failed');
+  q := 0;
+  writeln(qprinttype(q));
+  if not testdword_qword(q,false) then
+    writeln('test8 failed');
+
+  if error then
+    begin
+      writeln;
+      writeln('still range check problems!');
+      halt(1);
+    end;
+end.

tests/test/jvm/trange2.pp

@@ -0,0 +1,43 @@
+program trange2;
+
+{$mode objfpc}
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+{$else}
+uses
+  SysUtils;
+{$endif}
+
+{$r+}
+
+var
+  l: longint;
+  c: cardinal;
+  n: longint;
+begin
+  n := 0;
+  l := -1;
+  try
+    c := l;
+  except
+    writeln('caught 1!');
+    inc(n);
+  end;
+  c := cardinal($ffffffff);
+  try
+    l := c;
+  except
+    writeln('caught 2!');
+    inc(n);
+  end;
+  if n <> 2 then
+    begin
+      writeln('Still problems with range checking between longint/cardinal');
+      halt(1);
+    end;
+end.

tests/test/jvm/trange3.pp

@@ -0,0 +1,149 @@
+program trange3;
+
+{$mode objfpc}
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+
+{$else}
+uses
+  SysUtils;
+{$endif}
+
+
+{$r+}
+
+var
+  a1: array[-5..6] of byte;
+  a2: array[-12..-1] of byte;
+  a3: array[0..6] of byte;
+  a4: array[1..12] of byte;
+
+  c: cardinal;
+  l: longint;
+  b: byte;
+  finalerror: boolean;
+
+function check_longint(l: longint; res1, res2, res3, res4: boolean): boolean;
+var
+  caught,
+  error: boolean;
+begin
+  result := false;
+
+  caught := false;
+  try
+    b := a1[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res1;
+  if error then writeln('long 1 failed for '+unicodestring(JLInteger.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a2[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res2;
+  if error then writeln('long 2 failed for '+unicodestring(JLInteger.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a3[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res3;
+  if error then writeln('long 3 failed for '+unicodestring(JLInteger.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a4[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res4;
+  if error then writeln('long 4 failed for '+unicodestring(JLInteger.valueOf(l).toString));
+  result := result or error;
+  writeln;
+end;
+
+function check_cardinal(l: cardinal; res1, res2, res3, res4: boolean): boolean;
+var
+  caught,
+  error: boolean;
+begin
+  result := false;
+
+  caught := false;
+  try
+    b := a1[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res1;
+  if error then writeln('card 1 failed for '+unicodestring(JLLong.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a2[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res2;
+  if error then writeln('card 2 failed for '+unicodestring(JLLong.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a3[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res3;
+  if error then writeln('card 3 failed for '+unicodestring(JLLong.valueOf(l).toString));
+  result := result or error;
+
+  caught := false;
+  try
+    b := a4[l];
+  except
+    caught := true;
+  end;
+  error := caught <> res4;
+  if error then writeln('card 4 failed for '+unicodestring(JLLong.valueOf(l).toString));
+  result := result or error;
+  writeln;
+end;
+
+
+begin
+  finalerror :=
+    check_longint(-1,false,false,true,true);
+  finalerror :=
+    check_longint(-6,true,false,true,true) or finalerror;
+  finalerror :=
+    check_longint(0,false,true,false,true) or finalerror;
+  finalerror :=
+    check_cardinal(0,false,true,false,true);
+  finalerror :=
+    check_cardinal(cardinal($ffffffff),true,true,true,true) or finalerror;
+  finalerror :=
+    check_cardinal(5,false,true,false,false) or finalerror;
+  if finalerror then
+    begin
+      writeln('Still errors in range checking for array indexes');
+      halt(1);
+    end;
+end.

tests/test/jvm/tset1.pp

@@ -0,0 +1,183 @@
+{
+
+  Program to test set functions
+}
+
+{$define FPC_HAS_SET_INEQUALITIES}
+
+program tset1;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=jlsystem.fout.println}
+{$define write:=jlsystem.fout.println}
+{$endif}
+
+
+Procedure InitMSTimer;
+begin
+end;
+
+
+{Get MS Timer}
+Function MSTimer:longint;
+begin
+  MSTimer:=0;
+end;
+
+
+const
+  Lval=2000;
+VAR Box1, Box2:         ARRAY [0..255] OF BYTE;
+    OneWOTwo, TwoWOOne,
+    UnionSet, InterSet,
+    Set1, Set2, Set3:   SET OF BYTE;
+    K, MaxNr, L,
+    N, Low, Hi:         INTEGER;
+    Start:              LONGINT;
+
+begin
+   WriteLn ('Set operators functional and speed test');
+   WriteLn;
+
+   RandSeed := 17;
+
+   for L := 0 TO 255 DO begin
+      Box1 [L] := L;
+   end;
+   MaxNr := 255;
+   for L := 0 TO 255 DO begin
+      K := Random (MaxNr+1);
+      Box2 [L] := Box1 [K];
+      Box1 [K] := Box1 [MaxNr];
+      Dec (MaxNr);
+   end;
+
+   Start :=MSTimer;
+
+   Set1 := [];
+   Set2 := [];
+   for L := 0 TO 255 DO begin
+      Set1 := Set1 + [Box2 [L]];
+      if NOT (Box2 [L] IN Set1) then begin
+         WriteLn ('error in AddElem or InSet functions');
+         Halt;
+         end;
+      Set2 := Set2 + [Box2 [L]] + [];
+   end;
+
+{$ifdef FPC_HAS_SET_INEQUALITIES }
+   if (Set1 <> Set2) OR (NOT (Set1 <= Set2)) OR (NOT (Set1 >= Set2)) then begin
+{$else FPC_HAS_SET_INEQUALITIES }
+   if (Set1 <> Set2) then begin
+{$endif FPC_HAS_SET_INEQUALITIES }
+      WriteLn ('error in relational operators 1');
+      Halt;
+      end;
+
+   for L := 0 TO 255 DO begin
+      Set1 := Set1 - [Box2 [L]];
+      if Box2 [L] IN Set1 then begin
+         WriteLn ('error in set difference 1');
+         Halt;
+         end;
+   end;
+
+   if Set1 <> [] then begin
+      WriteLn ('error in set difference 2');
+      Halt;
+      end;
+
+   for L := 1 TO LVal DO begin
+      REPEAT
+         Low := Random (256);
+         Hi  := Random (256);
+      UNTIL Low <= Hi;
+
+      Set1 := [];
+      Set1 := Set1 + [Low..Hi];
+      for K := 0 TO 255 DO begin
+         if (K IN Set1) AND ((K < Low) OR (K > Hi)) then begin
+            WriteLn ('wrong set inclusion in add range');
+            Halt;
+            end;
+         if (NOT (K IN Set1)) AND ((K >= Low) AND (K <= Hi)) then begin
+            WriteLn ('wrong set exclusion in add range');
+            Halt;
+            end;
+      end;
+   end;
+
+   for L := 1 TO LVal DO begin
+      Set1 := [];
+      Set2 := [];
+
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Low + Random (256-Low);
+         Set2:= Set1 + [Low..Hi];
+{$ifdef FPC_HAS_SET_INEQUALITIES }
+         if (Set1 >= Set2) AND (Set1 <> Set2) then begin
+{$else FPC_HAS_SET_INEQUALITIES }
+         if (Set1 <> Set2) then begin
+{$endif FPC_HAS_SET_INEQUALITIES }
+            WriteLn ('error in relational operators 2');
+            Halt;
+            end;
+{$ifdef FPC_HAS_SET_INEQUALITIES }
+         if NOT (Set1 <= Set2) then begin
+            WriteLn ('error in relational operators 3');
+            Halt;
+            end;
+{$endif FPC_HAS_SET_INEQUALITIES }
+         Set1 := Set2;
+
+      end;
+   end;
+
+   for L := 1 TO LVal DO begin
+      Set1 := [];
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Low + Random (256-Low);
+         Set1:= Set1 + [Low..Hi];
+      end;
+      Set2 := [];
+      for K := 1 TO 10 DO begin
+         Low := Random (256);
+         Hi  := Low + Random (256-Low);
+         Set2:= Set2 + [Low..Hi];
+      end;
+
+      OneWOTwo := Set1 - Set2;
+      TwoWOOne := Set2 - Set1;
+      InterSet := Set1 * Set2;
+      UnionSet := Set1 + Set2;
+
+      if InterSet <> (Set2 * Set1) then begin
+         WriteLn ('error in set difference');
+         Halt;
+         end;
+
+      if (InterSet + OneWOTwo) <> Set1 then begin
+         WriteLn ('error in set difference or intersection');
+         Halt;
+         end;
+
+      if (InterSet + TwoWOOne) <> Set2 then begin
+         WriteLn ('error in set difference or intersection');
+         Halt;
+         end;
+
+      if (OneWOTwo + TwoWOOne + InterSet) <> UnionSet then begin
+         WriteLn ('error in set union, intersection or difference');
+         Halt;
+         end;
+
+   end;
+  Start:=MSTimer-Start;
+//  WriteLn('Set test completes in ',Start,' ms');
+end.

tests/test/jvm/tset3.pp

@@ -0,0 +1,98 @@
+program tset3;
+
+{$modeswitch exceptions}
+
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=JLSystem.fout.println}
+{$define write:=JLSystem.fout.print}
+
+{$packset 1}
+type
+  tmini = 0..7;
+  tminiset = set of tmini;
+
+
+procedure do_error(w : word);
+  begin
+    write('Error: ');
+    writeln(w);
+    raise jlexception.create('error!');
+  end;
+
+{$ifdef proc}
+procedure testit;
+{$endif}
+var
+  s1,s2,s3 : tminiset;
+  b : byte;
+  m : tmini;
+begin
+  s1:=[];
+  if s1<>[] then
+    do_error(1);
+
+  s1:=[1];
+  if s1<>[1] then
+    do_error(2);
+
+  s2:=[2,3];
+  if s2<>[2,3] then
+    do_error(3);
+
+  b:=6;
+  s3:=[b,7];
+  if s3<>[6,7] then
+    do_error(4);
+
+  s1:=s1+s2;
+  if s1<>[1..3] then
+    do_error(5);
+
+  s2:=s1;
+
+  if not(s1=s2) then
+    do_error(6);
+
+  s3:=[4];
+
+  include(s1,4);
+  if s1<>[1..4] then
+    do_error(7);
+
+  s2:=s1;
+
+  exclude(s1,4);
+  if s1<>[1..3] then
+    do_error(8);
+
+  s2:=s2-s3;
+  if s1<>s2 then
+    do_error(9);
+
+  b:=4;
+  include(s1,b);
+  if s1<>[1..4] then
+    do_error(10);
+
+  s2:=s2+[b];
+  if s1<>s2 then
+    do_error(11);
+
+  s2:=s1;
+  m:=3;
+  s1:=s1-[m];
+  exclude(s2,m);
+  if s1<>s2 then
+    do_error(12);
+
+  writeln('ok');
+{$ifdef proc}
+end;
+
+begin
+  testit;
+{$endif}
+end.

tests/test/jvm/ttrig.pp

@@ -0,0 +1,50 @@
+program ttrig;
+
+{$modeswitch exceptions}
+
+uses
+  jdk15;
+
+{$macro on}
+{$define writeln:=JLSystem.fout.println}
+
+procedure do_error(i : longint);
+  begin
+//    writeln('Error near ',i);
+    raise JLException.create('Error near '+UnicodeString(JLInteger.valueOf(i).toString));
+  end;
+
+var
+  s0,s1,s2 : single;
+
+
+begin
+  writeln('--- Testing single functions ---');
+
+  // 0.0
+  s0:=0.0;
+
+  s1:=sin(s0);
+  if s1<>0.0 then
+    do_error(1);
+
+  s1:=cos(s0);
+  if s1<>1.0 then
+    do_error(2);
+
+  s1:=arctan(s0);
+  if s1<>0.0 then
+    do_error(3);
+
+  // pi/2
+  s2:=pi/2;
+
+  s1:=sin(s2);
+  if s1<>1.0 then
+    do_error(100);
+
+  s1:=cos(s2);
+  { with single precision, the result is -4.371138829E-08 }
+  if abs(s1-0.0)>4.371138829E-08 then
+    do_error(101);
+end.

tests/test/jvm/ttrunc.pp

@@ -0,0 +1,241 @@
+{ this tests the trunc routine }
+program ttrunc;
+
+{$modeswitch exceptions}
+
+uses
+  jdk15;
+
+{$macro on}
+
+{$define write:=jlsystem.fout.print}
+{$define writeln:=jlsystem.fout.println}
+
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
+{$ifndef MACOS}
+{$APPTYPE CONSOLE}
+{$else}
+{$APPTYPE TOOL}
+{$endif}
+
+const
+  RESULT_ONE = 1234;
+  VALUE_ONE = 1234.5678;
+  RESULT_CONST_ONE = trunc(VALUE_ONE);
+  RESULT_TWO = -1234;
+  VALUE_TWO = -1234.5678;
+  RESULT_CONST_TWO = trunc(VALUE_TWO);
+
+
+ procedure fail;
+  begin
+    WriteLn('Failed!');
+    raise jlexception.create('boo');
+  end;
+
+procedure test_trunc_real;
+var
+ r: real;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() real testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+procedure test_trunc_single;
+var
+ r: single;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() single testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+procedure test_trunc_double;
+var
+ r: double;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() double testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+
+
+{$ifndef SKIP_CURRENCY_TEST}
+procedure test_trunc_currency;
+var
+ r: currency;
+ _success : boolean;
+ l: longint;
+Begin
+ Write('Trunc() currency testing...');
+ _success := true;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_ONE then
+   _success:=false;
+ if Trunc(VALUE_ONE)<>RESULT_ONE then
+   _success:=false;
+ r:=VALUE_ONE;
+ if Trunc(r)<>RESULT_CONST_ONE then
+   _success := false;
+ r:=VALUE_ONE;
+ l:=Trunc(r);
+ if l<>RESULT_ONE then
+   _success:=false;
+ l:=Trunc(VALUE_ONE);
+ if l<>RESULT_ONE then
+   _success:=false;
+
+
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_TWO then
+   _success:=false;
+ if Trunc(VALUE_TWO)<>RESULT_TWO then
+   _success:=false;
+ r:=VALUE_TWO;
+ if Trunc(r)<>RESULT_CONST_TWO then
+   _success := false;
+ r:=VALUE_TWO;
+ l:=Trunc(r);
+ if l<>RESULT_TWO then
+   _success:=false;
+ l:=Trunc(VALUE_TWO);
+ if l<>RESULT_TWO then
+   _success:=false;
+
+
+ if not _success then
+   fail;
+ WriteLn('Success!');
+end;
+{$endif SKIP_CURRENCY_TEST}
+
+
+Begin
+  test_trunc_real;
+  test_trunc_single;
+  test_trunc_double;
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
+  test_trunc_currency;
+{$endif SKIP_CURRENCY_TEST}
+end.

tests/test/jvm/tvarpara.pp

@@ -0,0 +1,75 @@
+program tvarpara;
+
+{$mode objfpc}
+
+uses
+  jdk15;
+
+procedure test(var c: char);
+begin
+  if c<>'a' then
+    halt(1);
+  c:='b';
+end;
+
+procedure test(var c: widechar);
+begin
+  if c<>'a' then
+    halt(2);
+  c:='b';
+end;
+
+procedure test(var i: int64);
+begin
+end;
+
+var
+  l: longint;
+function f: longint;
+begin
+  result:=l;
+  inc(l);
+end;
+
+var
+  c: char;
+  w: widechar;
+  a: ansistring;
+  u: unicodestring;
+  s: shortstring;
+begin
+  c:='a';
+  test(c);
+  if c<>'b' then
+    halt(3);
+  a:='abc';
+  test(a[1]);
+  if a<>'bbc' then
+    begin
+      u:=a;
+      jlsystem.fout.println(length(a));
+      jlsystem.fout.println(length(u));
+      jlsystem.fout.println(a=u);
+      jlsystem.fout.println(unicodestring(a));
+      jlsystem.fout.println(unicodestring(ansistringclass(a).toString));
+      halt(4);
+    end;
+  s:='cba';
+  test(s[3]);
+  if s<>'cbb' then
+    begin
+      jlsystem.fout.println(unicodestring(s));
+      halt(5);
+    end;
+  w:='a';
+  test(w);
+  if w<>'b' then
+   halt(6);
+  u:='bac';
+  l:=2;
+  test(u[f]);
+  if u<>'bbc' then
+    halt(7);
+  if l<>3 then
+    halt(8);
+end.

tests/test/jvm/tvirtclmeth.pp

@@ -0,0 +1,102 @@
+program tvirtclmeth;
+
+{$mode delphi}
+
+uses
+  jdk15;
+
+type
+  tvirtclmethbase = class
+    constructor create(l: longint); virtual; overload;
+    class function test(l: longint): ansistring; virtual;
+  end;
+
+  tvirtclmethchild = class(tvirtclmethbase)
+    constructor create(l: longint); override; overload;
+    class function test(l: longint): ansistring; override;
+    procedure docreate;
+  end;
+
+  tvirtclmethchild2 = class(tvirtclmethchild)
+  end;
+
+  tcc = class of tvirtclmethbase;
+
+
+  constructor tvirtclmethbase.create(l: longint);
+    begin
+      if l<>1 then
+        raise jlexception.create('base class constructor but child expected');
+    end;
+
+  class function tvirtclmethbase.test(l: longint): ansistring;
+    begin
+      if l<>1 then
+        raise jlexception.create('base class but child expected');
+      result:='base';
+    end;
+
+  constructor tvirtclmethchild.create(l: longint);
+    begin
+      if l<>2 then
+        raise jlexception.create('child class constructor but base expected');
+    end;
+
+  class function tvirtclmethchild.test(l: longint): ansistring;
+    begin
+      if l<>2 then
+        raise jlexception.create('child class but base expected');
+      result:='child';
+    end;
+
+
+  procedure tvirtclmethchild.docreate;
+    var
+      c: tvirtclmethchild;
+    begin
+      c:=self.create(2);
+    end;
+
+var
+  cc: tcc;
+  c: tvirtclmethbase;
+begin
+  c:=tvirtclmethbase.create;
+  if c.test(1)<>'base' then
+    raise JLException.create('base 1 res');
+  c:=tvirtclmethchild.create;
+  if c.test(2)<>'child' then
+    raise JLException.create('child 1 res');
+  tvirtclmethchild(c).docreate;
+  cc:=tvirtclmethbase;
+  if cc.test(1)<>'base' then
+    raise JLException.create('base 2 res');
+  cc:=tvirtclmethchild;
+  if cc.test(2)<>'child' then
+    raise JLException.create('child 2 res');
+  cc:=tvirtclmethchild2;
+  if cc.test(2)<>'child' then
+    raise JLException.create('child2 1 res');
+
+  c:=tvirtclmethbase.create(1);
+  if not(c is tvirtclmethbase) then
+    raise JLException.create('base 4 res');
+  c:=tvirtclmethchild.create(2);
+  if not(c is tvirtclmethchild) then
+    raise JLException.create('child 4 res');
+  c:=tvirtclmethchild2.create(2);
+  if not(c is tvirtclmethchild2) then
+    raise JLException.create('child2 2 res');
+  cc:=tvirtclmethbase;
+  c:=cc.create(1);
+  if not(c is tvirtclmethbase) then
+    raise JLException.create('base 4 res');
+  cc:=tvirtclmethchild;
+  c:=cc.create(2);
+  if not(c is tvirtclmethchild) then
+    raise JLException.create('child 4 res');
+  cc:=tvirtclmethchild2;
+  c:=cc.create(2);
+  if not(c is tvirtclmethchild2) then
+    raise JLException.create('child2 3 res');
+end.

tests/test/jvm/twith.pp

@@ -0,0 +1,27 @@
+program twith;
+
+{$mode delphi}
+
+type
+  twithbase = class
+  end;
+
+   twithchild = class(twithbase)
+    procedure test; virtual;
+  end;
+
+procedure twithchild.test;
+begin
+end;
+
+
+function func: twithbase;
+begin
+  result:=twithchild.create;
+end;
+
+
+begin
+  with twithchild(func) do
+    test;
+end.

tests/test/jvm/uenum.pp

@@ -0,0 +1,13 @@
+unit uenum;
+
+{$mode delphi}
+
+interface
+
+type
+  myenumjumps = (meja = 5, mejb = -5, mejc = 102);
+  myenum = (mea, meb, mec, med);
+
+implementation
+
+end.

tests/test/jvm/unsupported.pp

@@ -0,0 +1,106 @@
+{ %norun }
+
+{ Note: these things *are* supported now, they just weren't when the test was
+  written (the purpose was to make sure the compiler didn't crash when trying
+  to compile these things, even though it generated invalid code for them)
+}
+
+{$mode delphi}
+{$t+}
+
+unit unsupported;
+
+interface
+
+type
+  tmyfunc = function(a: longint): longint;
+  tmyfuncobj = function(a: longint): longint of object;
+
+type
+  tc = class
+    function methfunc(a: longint): longint;
+    class procedure methproc; static;
+  end;
+  tcclass = class of tc;
+
+procedure test;
+
+implementation
+
+
+function tc.methfunc(a: longint): longint;
+begin
+end;
+
+class procedure tc.methproc;
+begin
+end;
+
+function func(a: longint): longint;
+begin
+  result:=a;
+end;
+
+procedure test;
+var
+  m: tmyfunc;
+  l: longint;
+  c: tc;
+  m2,m2a: tmyfuncobj;
+begin
+  m:=func;
+  l:=m(6);
+  m2:=c.methfunc;
+  l:=m2(60);
+  if assigned(m) then ;
+  if assigned(m2) then ;
+  if @m=nil then ;
+  if @m2=nil then ;
+  m2a:=m2;
+end;
+
+procedure testset;
+var
+  a,b: set of byte;
+begin
+  a:=[1..127];
+  b:=[4..129];
+  include(a,6);
+  a:=a*b+b-b><a;
+  if 3 in a then ;
+end;
+
+procedure testnest;
+var
+  a: longint;
+
+  procedure nest;
+    begin
+      a:=5;
+    end;
+
+begin
+  nest;
+end;
+
+
+procedure testclassref;
+var
+  cr: tcclass;
+begin
+  cr:=tc;
+end;  
+
+
+procedure callarrconst(a: array of const);
+begin
+  if a[0].vtype = vtInteger then ;
+  if a[0].vinteger=4 then ;
+end;
+
+procedure testarrconst;
+begin
+  callarrconst([32,1.0]);
+end;
+
+end.