* renamed Java-specific sstrings.inc/sstringh.inc to jsstrings.inc/

    jsstringh.inc -> use generic inc/sstrings.inc
  * added a bunch of extra {$ifdef FPC_HAS_XXX} protections around
    routines in inc/sstrings.inc and implemented those routines for
    the JVM target in java/jsstrings.inc
  * use the majority of the generic routine in sstrings.inc now also
    for the JVM target! Only a few changes were needed:
   o in a few places, calls to move() for copying shortstring->shortstring
     or shortstring->chararray were replaced with calls to a new inline
     helper that calls move() in the version in inc/sstrings.inc, and
     JLSystem.arraycopt() in in the version in java/jsstrings.inc
   o changed the currency argument to str() for the JVM target to constref
     so its address can be taken (has to be typecasted to int64 without
     changing the value), and similarly changed the temporary result
     inside that routine to an array of 1 elements so the address can be
     taken
   o don't typecast the real value to a record type in str_real for the
     JVM target, but work via an int64 instead to extract sign/mantissa/exp
   o everything else compiled and worked as is!!
  -> val, str, hexstr/octstr/binstr, delete, pos, insert, setstring and
     comparetext now all work for shortstrings on the JVM target

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

.gitattributes

@@ -9803,9 +9803,20 @@ 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/tstring1.pp svneol=native#text/plain
+tests/test/jvm/tstrreal1.pp svneol=native#text/plain
+tests/test/jvm/tstrreal2.pp svneol=native#text/plain
 tests/test/jvm/tthreadvar.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/tval.inc svneol=native#text/plain
+tests/test/jvm/tval.pp svneol=native#text/plain
+tests/test/jvm/tval1.pp svneol=native#text/plain
+tests/test/jvm/tval2.pp svneol=native#text/plain
+tests/test/jvm/tval3.pp svneol=native#text/plain
+tests/test/jvm/tval4.pp svneol=native#text/plain
+tests/test/jvm/tval5.pp svneol=native#text/plain
+tests/test/jvm/tvalc.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

rtl/inc/real2str.inc

@@ -33,6 +33,7 @@ const
   maxDigits = 17;
 {$else}
 {$ifdef SUPPORT_DOUBLE}
+{$ifndef cpujvm}
 type
   TSplitDouble = packed record
     case byte of
@@ -40,6 +41,7 @@ type
       1: (words: Array[0..3] of word);
       2: (cards: Array[0..1] of cardinal);
   end;
+  {$endif}
 const
   maxDigits = 15;
 {$else}
@@ -62,6 +64,9 @@ type
   TIntPartStack = array[1..maxDigits+1] of valReal;
 
 var
+{$ifdef jvm}
+  doublebits: int64;
+{$endif}
   roundCorr, corrVal, factor : valReal;
   spos, endpos, fracCount: longint;
   correct, currprec: longint;
@@ -236,6 +241,14 @@ begin
          { correction used with comparing to avoid rounding/precision errors }
          roundCorr := 1.0842021725e-19;
       end;
+    else
+      begin
+        { keep JVM byte code verifier happy }
+        maxlen:=0;
+        minlen:=0;
+        explen:=0;
+        roundCorr:=0;
+      end;
     end;
   { check parameters }
   { default value for length is -32767 }
@@ -281,11 +294,19 @@ begin
   {$error sign/NaN/Inf not yet supported for big endian CPU's in str_real}
 {$else SUPPORT_EXTENDED}
 {$ifdef SUPPORT_DOUBLE}
+{$ifdef cpujvm}
+  doublebits := JLDouble.doubleToLongBits(d);
+  sign := doublebits<0;
+  expMaximal := (doublebits shr (32+20)) and $7ff = 2047;
+  fraczero:= (((doublebits shr 32) and $fffff) = 0) and
+             (longint(doublebits)=0);
+{$else cpujvm}
   { double, format (MSB): 1 Sign bit, 11 bit exponent, 52 bit mantissa }
   sign := ((TSplitDouble(d).cards[0] shr 20) and $800) <> 0;
   expMaximal := ((TSplitDouble(d).cards[0] shr 20) and $7ff) = 2047;
   fraczero:= (TSplitDouble(d).cards[0] and $fffff = 0) and
               (TSplitDouble(d).cards[1] = 0);
+{$endif cpujvm}
 {$else SUPPORT_DOUBLE}
 {$ifdef SUPPORT_SINGLE}
   { single, format (MSB): 1 Sign bit, 8 bit exponent, 23 bit mantissa }

rtl/inc/sstrings.inc

@@ -15,6 +15,24 @@
                     subroutines for string handling
 ****************************************************************************}
 
+{$ifndef FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
+{$define FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
+procedure fpc_shortstr_shortstr_intern_charmove(const src: shortstring; const srcindex: byte; var dst: shortstring; const dstindex, len: byte); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  move(src[srcindex],dst[dstindex],len);
+end;
+{$endif FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
+
+{$ifndef FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
+{$define FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
+procedure fpc_shortstr_chararray_intern_charmove(const src: shortstring; out dst: array of char; const len: sizeint); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  move(src[1],pchar(@dst)^,len);
+end;
+{$endif FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
+
+
+
 {$ifndef FPC_HAS_SHORTSTR_SETLENGTH}
 {$define FPC_HAS_SHORTSTR_SETLENGTH}
 procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt);[Public,Alias : 'FPC_SHORTSTR_SETLENGTH']; compilerproc;
@@ -42,7 +60,7 @@ begin
    if count>length(s)-index then
     count:=length(s)-index;
   fpc_shortstr_Copy[0]:=chr(Count);
-  Move(s[Index+1],fpc_shortstr_Copy[1],Count);
+  fpc_shortstr_shortstr_intern_charmove(s,Index+1,fpc_shortstr_Copy,1,Count);
 end;
 {$endif FPC_HAS_SHORTSTR_COPY}
 
@@ -59,7 +77,7 @@ begin
       Count:=length(s)-Index+1;
      s[0]:=Chr(length(s)-Count);
      if Index<=Length(s) then
-      Move(s[Index+Count],s[Index],Length(s)-Index+1);
+      fpc_shortstr_shortstr_intern_charmove(s,Index+Count,s,Index,Length(s)-Index+1);
    end;
 end;
 {$endif FPC_HAS_SHORTSTR_DELETE}
@@ -88,8 +106,8 @@ begin
      else
       dec(indexlen,cut);
    end;
-  move(s[Index],s[Index+srclen],indexlen);
-  move(Source[1],s[Index],srclen);
+  fpc_shortstr_shortstr_intern_charmove(s,Index,s,Index+srclen,indexlen);
+  fpc_shortstr_shortstr_intern_charmove(Source,1,s,Index,srclen);
   s[0]:=chr(index+srclen+indexlen-1);
 end;
 {$endif FPC_HAS_SHORTSTR_INSERT}
@@ -108,7 +126,7 @@ begin
   indexlen:=Length(s)-Index+1;
   if (sizeint(length(s))+1=sizeof(s)) and (indexlen>0) then
    dec(indexlen);
-  move(s[Index],s[Index+1],indexlen);
+  fpc_shortstr_shortstr_intern_charmove(s,Index,s,Index+1,indexlen);
   s[Index]:=Source;
   s[0]:=chr(index+indexlen);
 end;
@@ -348,25 +366,35 @@ begin
    end;
 end;
 
-
+{$ifndef FPC_HAS_QWORD_HEX_SHORTSTR}
+{$define FPC_HAS_QWORD_HEX_SHORTSTR}
 Function  hexStr(Val:qword;cnt:byte):shortstring;
 begin
   hexStr:=hexStr(int64(Val),cnt);
 end;
+{$endif FPC_HAS_QWORD_HEX_SHORTSTR}
 
 
+{$ifndef FPC_HAS_QWORD_OCT_SHORTSTR}
+{$define FPC_HAS_QWORD_OCT_SHORTSTR}
 Function  OctStr(Val:qword;cnt:byte):shortstring;
 begin
   OctStr:=OctStr(int64(Val),cnt);
 end;
+{$endif FPC_HAS_QWORD_OCT_SHORTSTR}
 
 
+{$ifndef FPC_HAS_QWORD_BIN_SHORTSTR}
+{$define FPC_HAS_QWORD_BIN_SHORTSTR}
 Function  binStr(Val:qword;cnt:byte):shortstring;
 begin
   binStr:=binStr(int64(Val),cnt);
 end;
+{$endif FPC_HAS_QWORD_BIN_SHORTSTR}
 
 
+{$ifndef FPC_HAS_HEXSTR_POINTER_SHORTSTR}
+{$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
 function hexstr(val : pointer) : shortstring;
 var
   i : longint;
@@ -380,14 +408,17 @@ begin
      v:=v shr 4;
    end;
 end;
+{$endif FPC_HAS_HEXSTR_POINTER_SHORTSTR}
 
 
+{$ifndef FPC_HAS_SPACE_SHORTSTR}
+{$define FPC_HAS_SPACE_SHORTSTR}
 function space (b : byte): shortstring;
 begin
   space[0] := chr(b);
   FillChar (Space[1],b,' ');
 end;
-
+{$endif FPC_HAS_SPACE_SHORTSTR}
 
 {*****************************************************************************
                               Str() Helpers
@@ -442,8 +473,7 @@ begin
 end;
 {$endif}
 
-{$ifndef FPC_SHORTSTR_ENUM_INTERN}
-{$define FPC_SHORTSTR_ENUM_INTERN}
+{$ifndef FPC_STR_ENUM_INTERN}
 function fpc_shortstr_enum_intern(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring): longint;
 
 { The following contains the TTypeInfo/TTypeData records from typinfo.pp
@@ -595,10 +625,9 @@ begin
 end;
 
 { also define alias for internal use in the system unit }
-procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);external name 'FPC_SHORTSTR_BOOL';
+procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);external {$ifndef cpujvm}name 'FPC_SHORTSTR_BOOL'{$endif};
 
-
-procedure fpc_shortstr_currency(c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc;
+procedure fpc_shortstr_currency({$ifdef cpujvm}constref{$endif} c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc;
 const
   MinLen = 8; { Minimal string length in scientific format }
 var
@@ -797,7 +826,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 
 
@@ -813,7 +842,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 
 
@@ -831,7 +860,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 
 
@@ -847,7 +876,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 
 {$endif CPU64}
@@ -864,11 +893,11 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 {$endif}
 
-
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_chararray_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out a : array of char);compilerproc;
 var
   ss : shortstring;
@@ -879,9 +908,9 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
-
+{$endif not FPC_STR_ENUM_INTERN}
 
 procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of char);compilerproc;
 var
@@ -893,7 +922,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 
 
@@ -908,7 +937,7 @@ begin
     maxlen:=length(ss)
   else
     maxlen:=high(a)+1;
-  move(ss[1],pchar(@a)^,maxlen);
+  fpc_shortstr_chararray_intern_charmove(ss,a,maxlen);
 end;
 {$endif FPC_HAS_STR_CURRENCY}
 
@@ -1325,6 +1354,7 @@ begin
 end;
 {$endif}
 
+{$ifndef FPC_STR_ENUM_INTERN}
 function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; [public, alias:'FPC_VAL_ENUM_SHORTSTR']; compilerproc;
 
     function string_compare(const s1,s2:shortstring):sizeint;
@@ -1411,6 +1441,7 @@ end;
 
 {Redeclare fpc_val_enum_shortstr for internal use in the system unit.}
 function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint;external name 'FPC_VAL_ENUM_SHORTSTR';
+{$endif FPC_STR_ENUM_INTERN}
 
 function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; [public, alias:'FPC_VAL_CURRENCY_SHORTSTR']; compilerproc;
 const
@@ -1418,12 +1449,13 @@ const
   Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10;
   Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10;
 var
-  res : Int64;
+  { to enable taking the address on the JVM target }
+  res : array[0..0] of Int64;
   i,j,power,sign,len : longint;
   FracOverflow : boolean;
 begin
   fpc_Val_Currency_ShortStr:=0;
-  res:=0;
+  res[0]:=0;
   len:=Length(s);
   Code:=1;
   sign:=1;
@@ -1454,9 +1486,9 @@ begin
           begin
             j:=Ord(s[code])-Ord('0');
             { check overflow }
-            if (res <= Int64Edge) or (res <= (MaxInt64 - j) div 10) then
+            if (res[0] <= Int64Edge) or (res[0] <= (MaxInt64 - j) div 10) then
               begin
-                res:=res*10 + j;
+                res[0]:=res[0]*10 + j;
                 Inc(i);
               end
             else
@@ -1465,9 +1497,9 @@ begin
                 exit
               else
                 begin
-                  if not FracOverflow and (j >= 5) and (res < MaxInt64) then
+                  if not FracOverflow and (j >= 5) and (res[0] < MaxInt64) then
                     { round if first digit of fractional part overflow }
-                    Inc(res);
+                    Inc(res[0]);
                   FracOverflow:=True;
                 end;
           end;
@@ -1528,24 +1560,26 @@ begin
   if power > 0 then
     begin
       for i:=1 to power do
-        if res <= Int64Edge2 then
-          res:=res*10
+        if res[0] <= Int64Edge2 then
+          res[0]:=res[0]*10
         else
           exit;
     end
   else
     for i:=1 to -power do
       begin
-        if res <= MaxInt64 - 5 then
-          Inc(res, 5);
-        res:=res div 10;
+        if res[0] <= MaxInt64 - 5 then
+          Inc(res[0], 5);
+        res[0]:=res[0] div 10;
       end;
-  res:=res*sign;
-  fpc_Val_Currency_ShortStr:=PCurrency(@res)^;
+  res[0]:=res[0]*sign;
+  fpc_Val_Currency_ShortStr:=PCurrency(@res[0])^;
   Code:=0;
 end;
 
 
+{$ifndef FPC_HAS_SETSTRING_SHORTSTR}
+{$define FPC_HAS_SETSTRING_SHORTSTR}
 Procedure SetString (Out S : Shortstring; Buf : PChar; Len : SizeInt);
 begin
   If Len > High(S) then
@@ -1556,7 +1590,10 @@ begin
       Move (Buf[0],S[1],Len);
     end;
 end;
+{$endif FPC_HAS_SETSTRING_SHORTSTR}
 
+{$ifndef FPC_HAS_COMPARETEXT_SHORTSTR}
+{$define FPC_HAS_COMPARETEXT_SHORTSTR}
 function ShortCompareText(const S1, S2: shortstring): SizeInt;
 var
   c1, c2: Byte;
@@ -1593,5 +1630,6 @@ begin
   else
     ShortCompareText := L1 - L2;
 end;
+{$endif FPC_HAS_COMPARETEXT_SHORTSTR}
 
 

rtl/java/compproc.inc

@@ -62,23 +62,28 @@ function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring
 { Str() support }
 procedure fpc_ShortStr_sint(v : valsint;len : SizeInt;out s : shortstring); compilerproc;
 procedure fpc_shortstr_uint(v : valuint;len : SizeInt;out s : shortstring); compilerproc;
-(*
 {$ifndef FPUNONE}
 procedure fpc_ShortStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : shortstring); compilerproc;
 {$endif}
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:shortstring);compilerproc;
+{$endif FPC_STR_ENUM_INTERN}
 procedure fpc_shortstr_bool(b : boolean;len:sizeint;out s:shortstring);compilerproc;
-procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstring); compilerproc;
+{ constref is to enable taking the address of c }
+procedure fpc_ShortStr_Currency({$ifdef cpujvm}constref{$endif} c : currency; len,f : SizeInt; out s : shortstring); compilerproc;
 
 procedure fpc_chararray_sint(v : valsint;len : SizeInt;out a : array of AnsiChar); compilerproc;
 procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of AnsiChar); compilerproc;
+(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
 procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
 {$ifndef FPUNONE}
 procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
 {$endif}
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring); compilerproc;
+{$endif FPC_STR_ENUM_INTERN}
 procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerproc;
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
@@ -99,9 +104,9 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
 {$ifndef CPU64}
   procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring); compilerproc;
   procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring); compilerproc;
-(*
   procedure fpc_chararray_qword(v : qword;len : SizeInt;out a : array of AnsiChar); compilerproc;
   procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of AnsiChar); compilerproc;
+(*
   {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
   procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc;
   procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc;
@@ -125,7 +130,9 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
     {$ifndef FPUNONE}
     procedure fpc_WideStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : WideString); compilerproc;
     {$endif}
+    {$ifndef FPC_STR_ENUM_INTERN}
     procedure fpc_widestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:widestring);compilerproc;
+    {$endif FPC_STR_ENUM_INTERN}
     procedure fpc_widestr_bool(b : boolean;len:sizeint;out s:widestring);compilerproc;
     {$ifdef FPC_HAS_STR_CURRENCY}
     procedure fpc_WideStr_Currency(c : Currency;len,fr : SizeInt;out s : WideString);compilerproc;
@@ -135,18 +142,23 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
     {$ifndef FPUNONE}
     procedure fpc_UnicodeStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : UnicodeString); compilerproc;
     {$endif}
+    {$ifndef FPC_STR_ENUM_INTERN}
     procedure fpc_unicodestr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:unicodestring);compilerproc;
+    {$endif FPC_STR_ENUM_INTERN}
     procedure fpc_unicodestr_bool(b : boolean;len:sizeint;out s:unicodestring);compilerproc;
     {$ifdef FPC_HAS_STR_CURRENCY}
     procedure fpc_UnicodeStr_Currency(c : Currency;len,fr : SizeInt;out s : UnicodeString);compilerproc;
     {$endif FPC_HAS_STR_CURRENCY}
   {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+*)
 
 {$ifndef FPUNONE}
 procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of AnsiChar); compilerproc;
 {$endif}
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_chararray_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out a : array of AnsiChar);compilerproc;
+{$endif}
 procedure fpc_chararray_bool(b : boolean;len:sizeint;out a : array of AnsiChar);compilerproc;
 {$ifdef FPC_HAS_STR_CURRENCY}
 procedure fpc_chararray_Currency(c : Currency;len,fr : SizeInt;out a : array of AnsiChar);compilerproc;
@@ -158,16 +170,22 @@ Function fpc_Val_Real_ShortStr(const s : shortstring; out code : ValSInt): ValRe
 {$endif}
 Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; compilerproc;
 Function fpc_Val_UInt_Shortstr(Const S: ShortString; out Code: ValSInt): ValUInt; compilerproc;
+{$ifndef FPC_STR_ENUM_INTERN}
 function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code:valsint):longint; compilerproc;
+{$endif FPC_STR_ENUM_INTERN}
 Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; compilerproc;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
+(*
 {$ifndef FPUNONE}
 Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
 {$endif}
 Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
 Function fpc_Val_SInt_AnsiStr (DestSize: SizeInt; Const S : AnsiString; out Code : ValSInt): ValSInt; compilerproc;
 Function fpc_Val_Currency_AnsiStr(Const S : AnsiString; out Code : ValSInt): Currency; compilerproc;
+{$ifndef FPC_STR_ENUM_INTERN}
 function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:valsint):longint; compilerproc;
+{$endif}
+*)
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
@@ -177,23 +195,30 @@ function fpc_Val_enum_ansistr(str2ordindex:pointer;const s:ansistring;out code:v
   {$endif}
   Function fpc_Val_SInt_WideStr (DestSize: SizeInt; Const S : WideString; out Code : ValSInt): ValSInt; compilerproc;
   Function fpc_Val_UInt_WideStr (Const S : WideString; out Code : ValSInt): ValUInt; compilerproc;
+  {$ifndef FPC_STR_ENUM_INTERN}
   function fpc_val_Enum_WideStr (str2ordindex:pointer;const s:WideString;out code:valsint):longint;compilerproc;
+  {$endif FPC_STR_ENUM_INTERN}
   Function fpc_Val_Currency_WideStr(Const S : WideString; out Code : ValSInt): Currency; compilerproc;
   {$endif not(defined(FPC_WIDESTRING_EQUAL_UNICODESTRING)) or defined(VER2_2)}
   {$ifndef VER2_2}
+  (*
   {$ifndef FPUNONE}
   Function fpc_Val_Real_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): ValReal; compilerproc;
   {$endif}
   Function fpc_Val_SInt_UnicodeStr (DestSize: SizeInt; Const S : UnicodeString; out Code : ValSInt): ValSInt; compilerproc;
   Function fpc_Val_UInt_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): ValUInt; compilerproc;
+  {$ifndef FPC_STR_ENUM_INTERN}
   function fpc_val_Enum_UnicodeStr(str2ordindex:pointer;const s:UnicodeString;out code:valsint):longint;compilerproc;
+  {$endif FPC_STR_ENUM_INTERN}
   Function fpc_Val_Currency_UnicodeStr(Const S : UnicodeString; out Code : ValSInt): Currency; compilerproc;
+*)
   {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 
 {$ifndef CPU64}
 Function fpc_val_int64_shortstr(Const S: ShortString; out Code: ValSInt): Int64; compilerproc;
 Function fpc_val_qword_shortstr(Const S: ShortString; out Code: ValSInt): QWord; compilerproc;
+(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Function fpc_Val_qword_AnsiStr (Const S : AnsiString; out Code : ValSInt): qword;compilerproc;
 Function fpc_Val_int64_AnsiStr (Const S : AnsiString; out Code : ValSInt): Int64; compilerproc;
@@ -209,9 +234,11 @@ Function fpc_Val_qword_UnicodeStr (Const S : UnicodeString; out Code : ValSInt):
 Function fpc_Val_int64_UnicodeStr (Const S : UnicodeString; out Code : ValSInt): Int64; compilerproc;
 {$endif VER2_2}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
+*)
 
 {$endif CPU64}
 
+(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
 Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
@@ -409,7 +436,9 @@ procedure fpc_write_text_int64_iso(len : longint;var t : text;i : int64); compil
 Procedure fpc_Write_Text_Float(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
 Procedure fpc_Write_Text_Float_Iso(rt,fixkomma,Len : Longint;var t : Text;r : ValReal); compilerproc;
 {$endif}
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_write_text_enum(typinfo,ord2strindex:pointer;len:sizeint;var t:text;ordinal:longint); compilerproc;
+{$endif FPC_STR_ENUM_INTERN}
 {$ifdef FPC_HAS_STR_CURRENCY}
 Procedure fpc_Write_Text_Currency(fixkomma,Len : Longint;var t : Text;c : Currency); compilerproc;
 {$endif FPC_HAS_STR_CURRENCY}
@@ -485,7 +514,9 @@ Procedure fpc_Read_Text_UInt(var f : Text; out u :ValUInt); compilerproc;
 {$ifndef FPUNONE}
 Procedure fpc_Read_Text_Float(var f : Text; out v :ValReal); compilerproc;
 {$endif}
+{$ifndef FPC_STR_ENUM_INTERN}
 procedure fpc_read_text_enum(str2ordindex:pointer;var t:text;out ordinal:longint); compilerproc;
+{$endif FPC_STR_ENUM_INTERN}
 procedure fpc_Read_Text_Currency(var f : Text; out v : Currency); compilerproc;
 {$ifndef CPU64}
 Procedure fpc_Read_Text_QWord(var f : text; out q : qword); compilerproc;

rtl/java/jsstringh.inc

@@ -50,59 +50,4 @@ type
    class function CreateFromLiteralStringBytes(const u: unicodestring): TAnsiCharArray; static;
   end;
 
-//Function Pos (Const Substr : Ansistring; Const Source : Ansistring) : SizeInt;
-//Function Pos (c : AnsiChar; Const s : Ansistring) : SizeInt;
-//Function Pos (c : AnsiString; Const s : UnicodeString) : SizeInt;
-//Function Pos (c : UnicodeString; Const s : AnsiString) : SizeInt;
-//Function Pos (c : ShortString; Const s : UnicodeString) : SizeInt;
-Function Pos (c : AnsiChar; Const s : Shortstring) : SizeInt;
-Function Pos (const substr : ShortString; Const source : Shortstring) : SizeInt;
-//Function Pos (c : char; Const s : UnicodeString) : SizeInt;
-
-Function UpCase(const s : shortstring) : shortstring;
-Function LowerCase(const s : shortstring) : shortstring;
-//Function UpCase(c:UnicodeChar):UnicodeChar;
-
-//Procedure Insert (Const Source : UnicodeString; Var S : UnicodeString; Index : SizeInt);
-//Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
-//Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
-//Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
-//
-//function WideCharToString(S : PWideChar) : AnsiString;
-//function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
-//function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
-//procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
-//procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
-//
-//function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
-//function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
-//function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
-//procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
-//procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
-//
-//procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
-//procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
-
-//function UnicodeToUtf8(Dest: PChar; Source: PUnicodeChar; MaxBytes: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function UnicodeToUtf8(Dest: PChar; MaxDestBytes: SizeUInt; Source: PUnicodeChar; SourceChars: SizeUInt): SizeUInt;
-//function Utf8ToUnicode(Dest: PUnicodeChar; Source: PChar; MaxChars: SizeInt): SizeInt;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar; SourceBytes: SizeUInt): SizeUInt;
-//function UTF8Encode(const s : Ansistring) : UTF8String; inline;
-//function UTF8Encode(const s : UnicodeString) : UTF8String;
-//function UTF8Decode(const s : UTF8String): UnicodeString;
-//function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
-//function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
-//function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
-//function WideStringToUCS4String(const s : WideString) : UCS4String;
-//function UCS4StringToWideString(const s : UCS4String) : WideString;
-
-//Procedure GetWideStringManager (Var Manager : TUnicodeStringManager);
-//Procedure SetWideStringManager (Const New : TUnicodeStringManager);
-//Procedure SetWideStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
-
-//Procedure GetUnicodeStringManager (Var Manager : TUnicodeStringManager);
-//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager);
-//Procedure SetUnicodeStringManager (Const New : TUnicodeStringManager; Var Old: TUnicodeStringManager);
-
 

rtl/java/jsstrings.inc

@@ -196,52 +196,83 @@ begin
 end;
 
 
-procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
+{$define FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
+procedure fpc_shortstr_shortstr_intern_charmove(const src: shortstring; const srcindex: byte; var dst: shortstring; const dstindex, len: byte); {$ifdef SYSTEMINLINE}inline;{$endif}
 begin
-  if len>255 then
-    len:=255;
-  ShortstringClass(@s).curlen:=len;
+  JLSystem.arraycopy(JLObject(ShortstringClass(@src).fdata),srcindex-1,JLObject(ShortstringClass(@dst).fdata),dstindex-1,len);
+end;
+
+{$define FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
+procedure fpc_shortstr_chararray_intern_charmove(const src: shortstring; out dst: array of char; const len: sizeint); {$ifdef SYSTEMINLINE}inline;{$endif}
+begin
+  JLSystem.arraycopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@dst),0,len);
 end;
 
 
+
+{$define FPC_HAS_CHAR_TO_SHORTSTR}
 procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
 {
-  Converts a WideChar to a ShortString;
+  Converts an AnsiChar to a ShortString;
 }
-
 begin
   setlength(res,1);
   ShortstringClass(@res).fdata[0]:=c;
 end;
 
 
-Function  fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
+
+{$define FPC_HAS_SHORTSTR_POS_SHORTSTR}
+Function Pos (Const Substr : Shortstring; Const s : Shortstring) : SizeInt;
+var
+  i,j,k,MaxLen, SubstrLen : SizeInt;
 begin
-  if count<0 then
-   count:=0;
-  if index>1 then
-   dec(index)
-  else
-   index:=0;
-  if index>length(s) then
-   count:=0
-  else
-   if count>length(s)-index then
-    count:=length(s)-index;
-  ShortstringClass(@result).curlen:=count;
-  JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),index,JLObject(ShortstringClass(@result).fdata),0,count);
+  Pos:=0;
+  SubstrLen:=Length(SubStr);
+  if SubstrLen>0 then
+   begin
+     MaxLen:=Length(s)-Length(SubStr);
+     i:=0;
+     while (i<=MaxLen) do
+      begin
+        inc(i);
+        j:=0;
+        k:=i-1;
+        while (j<SubstrLen) and
+              (ShortstringClass(@SubStr).fdata[j]=ShortstringClass(@s).fdata[k]) do
+          begin
+            inc(j);
+            inc(k);
+          end;
+        if (j=SubstrLen) then
+         begin
+           Pos:=i;
+           exit;
+         end;
+      end;
+   end;
 end;
 
 
-function  fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
+{$define FPC_HAS_SHORTSTR_POS_CHAR}
+{Faster when looking for a single char...}
+function pos(c:char;const s:shortstring):SizeInt;
+var
+  i : SizeInt;
 begin
-  if (index=1) and (Count>0) then
-   fpc_char_Copy:=c
-  else
-   fpc_char_Copy:='';
+  for i:=0 to length(s)-1 do
+   begin
+     if ShortStringClass(@s).fdata[i]=c then
+       begin
+         pos:=i+1;
+         exit;
+       end;
+   end;
+  pos:=0;
 end;
 
 
+{$define FPC_UPCASE_SHORTSTR}
 function upcase(const s : shortstring) : shortstring;
 var
   u : unicodestring;
@@ -251,6 +282,7 @@ begin
 end;
 
 
+{$define FPC_UPCASE_CHAR}
 Function  upCase(c:Char):Char;
 var
   u : unicodestring;
@@ -262,6 +294,7 @@ begin
 end;
 
 
+{$define FPC_LOWERCASE_SHORTSTR}
 function lowercase(const s : shortstring) : shortstring;
 var
   u : unicodestring;
@@ -271,6 +304,7 @@ begin
 end;
 
 
+{$define FPC_LOWERCASE_CHAR}
 Function  lowerCase(c:Char):Char; overload;
 var
   u : unicodestring;
@@ -282,57 +316,19 @@ begin
 end;
 
 
-Function Pos (Const Substr : Shortstring; Const Source : Shortstring) : SizeInt;
-var
-  i,j,k,MaxLen, SubstrLen : SizeInt;
-begin
-  Pos:=0;
-  SubstrLen:=Length(SubStr);
-  if SubstrLen>0 then
-   begin
-     MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
-     while (i<=MaxLen) do
-      begin
-        inc(i);
-        j:=0;
-        k:=i-1;
-        while (j<SubstrLen) and
-              (ShortstringClass(@SubStr).fdata[j]=ShortstringClass(@Source).fdata[k]) do
-          begin
-            inc(j);
-            inc(k);
-          end;
-        if (j=SubstrLen) then
-         begin
-           Pos:=i;
-           exit;
-         end;
-      end;
-   end;
-end;
-
+{ defined as external aliases to the int64 versions }
+{$define FPC_HAS_QWORD_OCT_SHORTSTR}
+{$define FPC_HAS_QWORD_BIN_SHORTSTR}
+{$define FPC_HAS_QWORD_HEX_SHORTSTR}
 
-{ Faster version for a char alone. Must be implemented because   }
-{ pos(c: char; const s: shortstring) also exists, so otherwise   }
-{ using pos(char,pchar) will always call the shortstring version }
-{ (exact match for first argument), also with $h+ (JM)           }
-Function Pos (c : AnsiChar; Const s : ShortString) : SizeInt;
-var
-  i: SizeInt;
+{$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
+function hexstr(val : pointer) : shortstring;
 begin
-  for i:=1 to length(s) do
-   begin
-     if ShortstringClass(@s).fdata[i-1]=c then
-      begin
-        pos:=i;
-        exit;
-      end;
-   end;
-  pos:=0;
+  hexstr:=hexstr(JLObject(val).hashCode,sizeof(pointer)*2);
 end;
 
 
+{$define FPC_HAS_SPACE_SHORTSTR}
 function space (b : byte): shortstring;
 begin
   setlength(result,b);
@@ -345,35 +341,59 @@ end;
                               Str() Helpers
 *****************************************************************************}
 
-
-procedure fpc_shortstr_SInt(v : valSInt;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_SINT']; compilerproc;
+{$define FPC_HAS_SETSTRING_SHORTSTR}
+Procedure SetString (Out S : Shortstring; Buf : PChar; Len : SizeInt);
 begin
-  int_str(v,s);
-  if length(s)<len then
-    s:=space(len-length(s))+s;
+  If Len > High(S) then
+    Len := High(S);
+  SetLength(S,Len);
+  If Buf<>Nil then
+    begin
+      JLSystem.arraycopy(JLObject(Buf),0,JLObject(ShortstringClass(@S).fdata),0,len);
+    end;
 end;
 
-procedure fpc_shortstr_UInt(v : valUInt;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_UINT']; compilerproc;
-begin
-  int_str_unsigned(v,s);
-  if length(s)<len then
-    s:=space(len-length(s))+s;
-end;
 
-procedure fpc_shortstr_qword(v : qword;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_QWORD']; compilerproc;
-begin
-  int_str_unsigned(v,s);
-  if length(s)<len then
-    s:=space(len-length(s))+s;
+{$define FPC_HAS_COMPARETEXT_SHORTSTR}
+function ShortCompareText(const S1, S2: shortstring): SizeInt;
+var
+  c1, c2: Byte;
+  i: Integer;
+  L1, L2, Count: SizeInt;
+  P1, P2: PChar;
+begin
+  L1 := Length(S1);
+  L2 := Length(S2);
+  if L1 > L2 then
+    Count := L2
+  else
+    Count := L1;
+  i := 0;
+  P1 := @ShortstringClass(@S1).fdata[0];
+  P2 := @ShortstringClass(@S2).fdata[0];
+  c1 := 0;
+  c2 := 0;
+  while i < count do
+  begin
+    c1 := byte(p1[i]);
+    c2 := byte(p2[i]);
+    if c1 <> c2 then
+    begin
+      if c1 in [97..122] then
+        Dec(c1, 32);
+      if c2 in [97..122] then
+        Dec(c2, 32);
+      if c1 <> c2 then
+        Break;
+    end;
+    Inc(I);
+  end;
+  if i < count then
+    ShortCompareText := c1 - c2
+  else
+    ShortCompareText := L1 - L2;
 end;
 
 
-procedure fpc_shortstr_int64(v : int64;len : SizeInt;out s : shortstring);[public,alias:'FPC_SHORTSTR_INT64'];  compilerproc;
-begin
-  int_str(v,s);
-  if length(s)<len then
-    s:=space(len-length(s))+s;
-end;
-
 { lie, implemented internally in the compiler }
-{$define FPC_SHORTSTR_ENUM_INTERN}
+{$define FPC_STR_ENUM_INTERN}

rtl/java/jsystemh.inc

@@ -386,6 +386,7 @@ Function  Sseg:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
 (*
 function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
 function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
+*)
 
 { Shortstring functions }
 Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
@@ -393,11 +394,13 @@ Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);
 Procedure Insert(source:Char;var s:shortstring;index:SizeInt);
 Function  Pos(const substr:shortstring;const s:shortstring):SizeInt;
 Function  Pos(C:Char;const s:shortstring):SizeInt;
+(*
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Function  Pos (const Substr : ShortString; const Source : AnsiString) : SizeInt;
 Procedure SetString (out S : AnsiString; Buf : PChar; Len : SizeInt);
 Procedure SetString (out S : AnsiString; Buf : PWideChar; Len : SizeInt);
 {$endif FPC_HAS_FEATURE_ANSISTRINGS}
+*)
 Procedure SetString (out S : Shortstring; Buf : PChar; Len : SizeInt);
 function  ShortCompareText(const S1, S2: shortstring): SizeInt;
 Function  upCase(const s:shortstring):shortstring;
@@ -409,11 +412,10 @@ Function  binStr(Val:Longint;cnt:byte):shortstring;
 Function  hexStr(Val:int64;cnt:byte):shortstring;
 Function  OctStr(Val:int64;cnt:byte):shortstring;
 Function  binStr(Val:int64;cnt:byte):shortstring;
-Function  hexStr(Val:qword;cnt:byte):shortstring;
-Function  OctStr(Val:qword;cnt:byte):shortstring;
-Function  binStr(Val:qword;cnt:byte):shortstring;
+Function  hexStr(Val:qword;cnt:byte):shortstring; {$ifdef cpujvm}external;{$endif}
+Function  OctStr(Val:qword;cnt:byte):shortstring; {$ifdef cpujvm}external;{$endif}
+Function  binStr(Val:qword;cnt:byte):shortstring; {$ifdef cpujvm}external;{$endif}
 Function  hexStr(Val:Pointer):shortstring;
-*)
 
 { Char functions }
 Function chr(b : byte) : Char;      [INTERNPROC: fpc_in_chr_byte];

rtl/java/system.pp

@@ -80,12 +80,15 @@ const
     function fpcGenericValueOf(__fpc_int: longint): JLEnum;
   end;
 
+{ generic versions are based on FPC/Delphi-style RTTI }
+{$define FPC_STR_ENUM_INTERN}
+
 {$i jrech.inc}
 {$i jseth.inc}
 {$i jpvarh.inc}
 {$i jsystemh_types.inc}
 {$i jtvarh.inc}
-{$i sstringh.inc}
+{$i jsstringh.inc}
 {$i jdynarrh.inc}
 {$i astringh.inc}
 {$i jsystemh.inc}
@@ -105,6 +108,7 @@ function min(a,b : longint) : longint;
   end;
 
 {$i jtvar.inc}
+{$i jsstrings.inc}
 {$i jrec.inc}
 {$i jset.inc}
 {$i jpvar.inc}

tests/test/jvm/testall.bat

@@ -184,3 +184,20 @@ ppcjvm -O2 -g tthreadvar
 if %errorlevel% neq 0 exit /b %errorlevel%
 java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tthreadvar
 if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tstring1
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tstring1
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tstrreal1
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;.tstrreal1
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g tstrreal2
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tstrreal2
+if %errorlevel% neq 0 exit /b %errorlevel%
+ppcjvm -O2 -g -B tval
+if %errorlevel% neq 0 exit /b %errorlevel%
+java -Dfile.encoding=UTF-8 -cp ..\..\..\rtl\units\jvm-java;. tval
+if %errorlevel% neq 0 exit /b %errorlevel%
+

tests/test/jvm/testall.sh

@@ -102,3 +102,11 @@ $PPC -O2 -g getbit
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. getbit
 $PPC -O2 -g tthreadvar
 java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tthreadvar
+$PPC -O2 -g tstring1
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tstring1
+$PPC -O2 -g tstrreal1
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tstrreal1
+$PPC -O2 -g tstrreal2
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tstrreal2
+$PPC -O2 -g -B tval
+java -Dfile.encoding=UTF-8 -cp ../../../rtl/units/jvm-java:. tval

tests/test/jvm/tstring1.pp

@@ -0,0 +1,80 @@
+program tstring1;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+function TestOK:boolean;
+Const
+  TestStr: string[22]='HELLO, THIS IS A TEST ';
+var
+  I : INTEGER;
+  U : STRING[1];
+  Q : STRING[100];
+  S : STRING[55];
+  T : STRING[60];
+  V : STRING;
+begin
+  TestOk:=false;
+  T:='THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG 1234567890';
+  Insert (T, T, 1);
+  Delete (T, 55, 54);
+  S:=Copy (T, -5, 2);     {'TH'}
+  U:=Copy (T, 7, 4);      {'I'}
+  S:=S + U;               {'THI'}
+  Q:=Copy (T, 32, 70);    {'THE LAZY DOG 1234567890'}
+  Delete (Q, 2, 1);         {'TE LAZY DOG 1234567890'}
+  Delete (Q, 100, 2);       {'TE LAZY DOG 1234567890'}
+  Delete (Q, 3, -4);        {'TE LAZY DOG 1234567890'}
+  Delete (Q, 3, 10);        {'TE1234567890'}
+{  writeln('TE1234567890 - ',Q);}
+  I:=Pos ('S', T);        {25}
+  Insert(Copy(T,I,200),Q,3);{'TES OVER THE LAZY DOG 12345678901234567890'}
+  Delete (Q, 4, 6);         {'TESTHE LAZY DOG 12345678901234567890}
+  S:=S + T [25];          {'THIS'}
+  S:=S + Copy (S, 3, -5) + Copy (S, 3, 2);  {'THISIS'}
+  V:=T;                   {'THE QUICK BROWN FOX JUMPS OVER THE LAZY ..'}
+  Delete (V, 1, 36);      {'AZY DOG 1234567890'}
+  if (Copy (V, -7, -1)='') and (Pos ('DOG', V)=5) then {TRUE}
+   Insert (V, S, 200);    {'THISISAZY DOG 1234567890'}
+  U:=Copy (T, 44, 40);    {' '}
+  Insert (U, S, 5);         {'THIS ISAZY DOG 1234567890'}
+  I:=Pos ('ZY', S);       {9}
+  Delete (S, I, -5);        {'THIS ISAZY DOG 1234567890'}
+  Insert (Copy(S,5,1),S,8); {'THIS IS AZY DOG 1234567890'}
+  Delete (S, 10, 16);       {'THIS IS A0'}
+  if S [Length (S)]='0' then {TRUE}
+   S:=S + Q;            {'THIS IS A0TESTHE LAZY DOG 123456789012345...'}
+  V:=Copy (S, Length (S) - 19, 10); {'1234567890'}
+  if V=Copy (S, Length (S) - 9, 10) then {TRUE}
+   Delete (S, 15, 3 * Length (V)+2); {'THIS IS A0TEST'}
+  Insert ('', S, 0);        {'THIS IS A0TEST'}
+  Insert(Copy(S,5,1),S,11); {'THIS IS A0 TEST'}
+  Insert ('HELLO', S, -4);  {'HELLOTHIS IS A0 TEST'}
+  Insert (',', S, 6);       {'HELLO,THIS IS A0 TEST'}
+  Delete (S, Pos ('TEST', S) - 2, 1); {'HELLO,THIS IS A TEST'}
+  Delete (Q, 1, 32767);     {''}
+  Q:=Q + ' ';             {' '}
+  Insert (Q, S, 7);         {'HELLO, THIS IS A TEST'}
+  Insert (Q, S, 255);       {'HELLO, THIS IS A TEST '}
+  if (S=TestStr) and (Q=' ') and (V='1234567890') and
+     (T='THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG 1234567890') then
+   TestOK:=true;
+end;
+
+
+begin
+  if TestOK then
+   WriteLn('Test OK')
+  else
+    begin
+      WriteLn('Test Failure!');
+      halt(1);
+    end;  
+end.

tests/test/jvm/tstrreal1.pp

@@ -0,0 +1,52 @@
+
+program tstrreal1;
+
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+
+const
+  s: array[0..16] of string[13] =
+    ('99999.900000',
+     '99999.990000',
+     '99999.999000',
+     '99999.999900',
+     '99999.999990',
+     '99999.999999',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000',
+     '100000.000000');
+
+var
+  e,e2,e3: double;
+  s2: string;
+  c: longint;
+
+begin
+  e := 100000.0;
+  e2 := 0.1;
+  c := 0;
+  repeat
+    e3 := e-e2;
+    str(e3:0:6,s2);
+    writeln(s2);
+    if s2 <> s[c] then
+      begin
+        write('  Error, should be '); writeln(s[c]);
+        halt(1);
+      end;
+    e2 := e2 /10.0;
+    inc(c);
+  until e2 < 1e-17;
+end.

tests/test/jvm/tstrreal2.pp

@@ -0,0 +1,58 @@
+program tstrreal2;
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+const
+  s: array[1..21] of string =
+    ('10.00000000000000000',
+     '1.00000000000000000',
+     '0.10000000000000000',
+     '0.01000000000000000',
+     '0.00100000000000000',
+     '0.00010000000000000',
+     '0.00001000000000000',
+     '0.00000100000000000',
+     '0.00000010000000000',
+     '0.00000001000000000',
+     '0.00000000100000000',
+     '0.00000000010000000',
+     '0.00000000001000000',
+     '0.00000000000100000',
+     '0.00000000000010000',
+     '0.00000000000001000',
+     '0.00000000000000100',
+     '0.00000000000000010',
+     '0.00000000000000001',
+     '0.00000000000000000',
+     '0.00000000000000000');
+
+var
+  e: extended;
+  c: longint;
+  s2: string;
+  lenadjust: longint;
+begin
+  if sizeof(extended) = 8 then
+    lenadjust := 2
+  else
+    lenadjust := 0;
+  e := 10.0;
+  for c := 1 to 21 do
+    begin
+      str(e:0:17,s2);
+      writeln(s2);
+      if s2 <> copy(s[c],1,length(s[c])-lenadjust) then
+        begin
+          write('  Error, should be '); writeln(copy(s[c],1,length(s[c])-lenadjust));
+          halt(1);
+        end;
+      e := e / 10.0;
+    end;
+end.

tests/test/jvm/tval.inc

@@ -0,0 +1,280 @@
+
+{ Included by several source with different
+  definitions of the type
+  IntegerType
+  to check that the test is working for
+  all basic integer types }
+
+
+procedure TestVal(comment,s : string; ExpectedRes : ValTestType; expected : IntegerType);
+var
+  i : IntegerType;
+  err,err1 : word;
+  OK : boolean;
+begin
+  OK:=false;
+  if not silent and (Comment<>'') then
+    Writeln(Comment);
+  Val(s,i,err);
+  if ExpectedRes=ValShouldFail then
+    begin
+      if err=0 then
+        begin
+          if not silent or not HasErrors then
+           begin
+            Write('Error: string ');write(Display(s));
+              writeln(' is a valid input for val function');
+           end;   
+          HasErrors:=true;
+        end
+      else
+        begin
+          OK:=true;
+          if not silent then
+           begin
+            Write('Correct: string ');write(Display(s));
+              writeln(' is a not valid input for val function');
+           end;
+        end;
+    end
+  else if ExpectedRes=ValShouldSucceed then
+    begin
+      if err=0 then
+        begin
+          OK:=true;
+          if not silent then
+           begin
+            Write('Correct: string ');write(Display(s));
+              writeln(' is a valid input for val function');
+           end;
+        end
+      else
+        begin
+          if not silent or not HasErrors then
+           begin
+            Write('Error: string ');write(Display(s));
+              write(' is a not valid input for val function');
+              write(' error pos=');writeln(err);
+           end;
+          HasErrors:=true;
+        end;
+    end
+  else if ExpectedRes=ValShouldSucceedAfterRemovingTrail then
+    begin
+      if err=0 then
+        begin
+          if not silent or not HasErrors then
+           begin
+            Write('Error: string ');write(Display(s));
+              writeln(' is a valid input for val function');
+           end;
+          HasErrors:=true;
+        end
+      else
+        begin
+          err1:=err;
+          Val(Copy(s,1,err1-1),i,err);
+          if err=0 then
+            begin
+              OK:=true;
+              if not silent then
+               begin
+                Write('Correct: string ');write(Display(s));
+                  write(' is a valid input for val function up to position ');writeln(err1);
+               end;
+            end
+          else
+            begin
+              if not silent or not HasErrors then
+               begin
+                Write('Error: string ');write(Display(Copy(s,1,err1-1)));
+                  write(' is a not valid input for val function');
+                  write(' error pos=');writeln(err);
+               end;
+              HasErrors:=true;
+            end;
+        end;
+    end;
+  if (err=0) and CheckVal and (i<>expected) then
+    begin
+      OK:=false;
+      if not silent or not HasErrors then
+       begin
+        Write('Error: string ');write(Display(s));
+          write(' value is ');write(jlong(i));write(' <> ');writeln(jlong(expected));
+       end;
+      HasErrors:=true;
+    end;
+  if OK then
+    inc(SuccessCount)
+  else
+    inc(FailCount);
+end;
+
+Procedure TestBase(Const Prefix : string;ValidChars : TCharSet);
+var
+  i,j : longint;
+  st : string;
+begin
+  CheckVal:=false;
+  Silent:=true;
+  for i:=0 to 255 do
+    begin
+      st:=prefix+chr(i);
+      if chr(i) in ValidChars then
+        TestVal('',st,ValShouldSucceed,0)
+      else
+        TestVal('',st,ValShouldFail,0);
+    end;
+  for i:=0 to 255 do
+    for j:=0 to 255 do
+      begin
+        st:=prefix+chr(i)+chr(j);
+        if (chr(i) in ValidChars) and
+           (chr(j) in ValidChars) then
+          TestVal('',st,ValShouldSucceed,0)
+        else
+          begin
+            if ((prefix<>'') or
+               (not (chr(i) in SpecialCharsFirst))) and
+                not (chr(j) in SpecialCharsSecond) then
+              TestVal('',st,ValShouldFail,0);
+          end;
+      end;
+end;
+
+
+Function TestAll : boolean;
+
+var
+  S : string;
+begin
+  TestVal('Testing empty string','',ValShouldFail,0);
+  TestVal('Testing string with #0',#0,ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','0x',ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','x',ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','X',ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','$',ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','%',ValShouldFail,0);
+  TestVal('Testing string with base prefix and no value','&',ValShouldFail,0);
+  TestVal('Testing string with base prefix and #0','0x'#0,ValShouldFail,0);
+  TestVal('Testing normal ''''0'''' string','0',ValShouldSucceed,0);
+  TestVal('Testing leading space',' 0',ValShouldSucceed,0);
+  TestVal('Testing leading 2 spaces','  0',ValShouldSucceed,0);
+  TestVal('Testing leading 2 tabs',#9#9'0',ValShouldSucceed,0);
+  TestVal('Testing leading 3 spaces','   0',ValShouldSucceed,0);
+  TestVal('Testing leading 3 tabs',#9#9#9'0',ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination',#9' 0',ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination',' '#9'0',ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination',' '#9' 0',ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination',#9' '#9' 0',ValShouldSucceed,0);
+  TestVal('Testing #0 following normal ''''0''','0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading space with trailing #0',' 0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading 2 spaces with trailing #0','  0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading 2 tabs with trailing #0',#9#9'0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading 3 spaces with trailing #0','   0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading 3 tabs with trailing #0',#9#9#9'0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination with trailing #0',#9' 0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination with trailing #0',' '#9'0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination with trailing #0',' '#9' 0'#0,ValShouldSucceed,0);
+  TestVal('Testing leading space/tab combination with trailing #0',#9' '#9' 0'#0,ValShouldSucceed,0);
+  TestVal('Testing trailing space','0 ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing 2 spaces','0  ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing 2 tabs','0'#9#9,ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing 3 spaces','0   ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing 3 tabs','0'#9#9#9,ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing space/tab combination','0'#9' ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing space/tab combination','0 '#9,ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing space/tab combination','0 '#9' ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing trailing space/tab combination','0'#9' '#9' ',ValShouldSucceedAfterRemovingTrail,0);
+  TestVal('Testing several zeroes',' 00'#0,ValShouldSucceed,0);
+  TestVal('Testing normal zero','0',ValShouldSucceed,0);
+  TestVal('Testing several zeroes','00',ValShouldSucceed,0);
+  TestVal('Testing normal zero with leading space',' 0',ValShouldSucceed,0);
+  TestVal('Testing several zeroes with leading space',' 00',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','0x0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','x0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','X0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','$0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','%0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and zero','&0',ValShouldSucceed,0);
+  TestVal('Testing string with base prefix and one','0x1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and one','x1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and one','X1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and one','$1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and one','%1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and one','&1',ValShouldSucceed,1);
+  TestVal('Testing string with base prefix and two','0x2',ValShouldSucceed,2);
+  TestVal('Testing string with base prefix and two','x2',ValShouldSucceed,2);
+  TestVal('Testing string with base prefix and two','X2',ValShouldSucceed,2);
+  TestVal('Testing string with base prefix and two','$2',ValShouldSucceed,2);
+  TestVal('Testing string with base prefix and two','%2',ValShouldFail,0);
+  TestVal('Testing string with base prefix and two','&2',ValShouldSucceed,2);
+  TestVal('Testing string with base prefix and seven','0x7',ValShouldSucceed,7);
+  TestVal('Testing string with base prefix and seven','x7',ValShouldSucceed,7);
+  TestVal('Testing string with base prefix and seven','X7',ValShouldSucceed,7);
+  TestVal('Testing string with base prefix and seven','$7',ValShouldSucceed,7);
+  TestVal('Testing string with base prefix and seven','%7',ValShouldFail,0);
+  TestVal('Testing string with base prefix and seven','&7',ValShouldSucceed,7);
+  TestVal('Testing string with base prefix and eight','0x8',ValShouldSucceed,8);
+  TestVal('Testing string with base prefix and eight','x8',ValShouldSucceed,8);
+  TestVal('Testing string with base prefix and eight','X8',ValShouldSucceed,8);
+  TestVal('Testing string with base prefix and eight','$8',ValShouldSucceed,8);
+  TestVal('Testing string with base prefix and eight','%8',ValShouldFail,0);
+  TestVal('Testing string with base prefix and eight','&8',ValShouldFail,0);
+  TestVal('Testing string with base prefix and nine','0x9',ValShouldSucceed,9);
+  TestVal('Testing string with base prefix and nine','x9',ValShouldSucceed,9);
+  TestVal('Testing string with base prefix and nine','X9',ValShouldSucceed,9);
+  TestVal('Testing string with base prefix and nine','$9',ValShouldSucceed,9);
+  TestVal('Testing string with base prefix and nine','%9',ValShouldFail,0);
+  TestVal('Testing string with base prefix and nine','&9',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "a"','0xa',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "a"','xa',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "a"','Xa',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "a"','$a',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "a"','%a',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "a"','&a',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "A"','0xA',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "A"','xA',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "A"','XA',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "A"','$A',ValShouldSucceed,10);
+  TestVal('Testing string with base prefix and "A"','%A',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "A"','&A',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "f"','0xf',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "f"','xf',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "f"','Xf',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "f"','$f',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "f"','%f',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "f"','&f',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "F"','0xF',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "F"','xF',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "F"','XF',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "F"','$F',ValShouldSucceed,15);
+  TestVal('Testing string with base prefix and "F"','%F',ValShouldFail,0);
+  TestVal('Testing string with base prefix and "F"','&F',ValShouldFail,0);
+
+//  TestVal('Testing -zero','-0',ValShouldSucceed,0);
+  TestVal('Testing +zero','+0',ValShouldSucceed,0);
+  TestVal('Testing - zero','- 0',ValShouldFail,0);
+  TestVal('Testing + zero','+ 0',ValShouldFail,0);
+  TestVal('Testing --zero','--0',ValShouldFail,0);
+  TestVal('Testing ++zero','++0',ValShouldFail,0);
+  TestVal('Testing -+zero','-+0',ValShouldFail,0);
+
+  TestBase('%', ValidNumeralsBase2);
+  TestBase('&', ValidNumeralsBase8);
+  TestBase('', ValidNumeralsBase10);
+  TestBase('0x', ValidNumeralsBase16);
+
+  if HasErrors then
+    begin
+      Write(FailCount);write(' tests failed over ');writeln(SuccessCount+FailCount);
+    end
+  else
+    begin
+      Write('All tests succeeded count=');writeln(SuccessCount);
+    end;
+  TestAll:=HasErrors;
+
+end;
+

tests/test/jvm/tval.pp

@@ -0,0 +1,43 @@
+
+program tval;
+
+{$ifdef cpujvm}
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+uses
+{$ifdef cpujvm}
+  jdk15,
+{$endif}
+  { longint type, short string }
+  tval1,
+  { dword type, short string }
+  tval2,
+  { int64 type, short string }
+  tval3,
+  { uint64 type, short string }
+  tval4,
+  { common variables and functions }
+  tvalc;
+
+
+
+begin
+(*
+  if (paramcount>0) and
+     (paramstr(1)='verbose') then
+       silent:=false;
+*)
+  TestAllVal1;
+  TestAllVal2;
+  TestAllVal3;
+  TestAllVal4;
+  if HasErrors then
+    begin
+      Writeln('Test tval failed');
+      Halt(1);
+    end;
+end.

tests/test/jvm/tval1.pp

@@ -0,0 +1,37 @@
+
+unit tval1;
+
+{$mode fpc}
+
+interface
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+function TestAllVal1 : boolean;
+
+implementation
+
+uses
+  tvalc;
+
+type
+  IntegerType = longint;
+
+{$i tval.inc}
+
+
+function TestAllVal1 : boolean;
+begin
+  Writeln('Test val for longint type');
+  TestAllVal1:=TestAll;
+end;
+
+end.

tests/test/jvm/tval2.pp

@@ -0,0 +1,37 @@
+
+unit tval2;
+
+{$mode fpc}
+
+interface
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+function TestAllval2 : boolean;
+
+implementation
+
+uses
+  tvalc;
+
+type
+  IntegerType = dword;
+
+{$i tval.inc}
+
+
+function TestAllval2 : boolean;
+begin
+  Writeln('Test val for dword type');
+  TestAllval2:=TestAll;
+end;
+
+end.

tests/test/jvm/tval3.pp

@@ -0,0 +1,37 @@
+
+unit tval3;
+
+{$mode fpc}
+
+interface
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+function TestAllval3 : boolean;
+
+implementation
+
+uses
+  tvalc;
+
+type
+  IntegerType = int64;
+
+{$i tval.inc}
+
+
+function TestAllval3 : boolean;
+begin
+  Writeln('Test val for int64 type');
+  TestAllval3:=TestAll;
+end;
+
+end.

tests/test/jvm/tval4.pp

@@ -0,0 +1,37 @@
+
+unit tval4;
+
+{$mode fpc}
+
+interface
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+function TestAllval4 : boolean;
+
+implementation
+
+uses
+  tvalc;
+
+type
+  IntegerType = qword;
+
+{$i tval.inc}
+
+
+function TestAllval4 : boolean;
+begin
+  Writeln('Test val for qword type');
+  TestAllval4:=TestAll;
+end;
+
+end.

tests/test/jvm/tval5.pp

@@ -0,0 +1,223 @@
+{$mode objfpc}
+
+uses
+  sysutils;
+
+procedure testcard;
+const
+  h = 1;
+  hexch : array[0..15] of char='0123456789ABCDEF';
+var
+  c: cardinal;
+  l: longint;
+  s: shortstring;
+  b, b2: byte;
+  ch, ch2: char;
+{$ifdef cpu64}
+  caught: boolean;
+{$endif cpu64}
+begin
+  s:='$0fffffff';
+  for b := low(hexch) to high(hexch) do
+    begin
+      s[2]:=hexch[b];
+      val(s,c,l);
+      if (l<>0) then
+        halt(b+h);
+    end;
+    
+  s:='$fffffff0';
+  for b := low(hexch) to high(hexch) do
+    begin
+      s[length(s)]:=hexch[b];
+      val(s,c,l);
+      if (l<>0) then
+        halt(b+16+h);
+    end;
+
+  setlength(s,10);
+  s[1]:='$';
+  for b2:= 1 to high(hexch) do
+    begin
+      for b := 2 to length(s)-1 do
+        s[b]:=hexch[b2];
+      for b := low(hexch) to high(hexch) do
+        begin
+          s[length(s)]:=hexch[b];
+{$ifdef cpu64}
+{$r+}
+          try
+            caught:=false;
+{$endif cpu64}
+            val(s,c,l);
+{$ifdef cpu64}
+          except on e : exception do
+            caught:=true;
+          end;
+          if not caught then
+{$else cpu64}
+          if (l=0) then
+{$endif}
+            halt(b2+32+h);
+        end;
+    end;
+
+  s:='0294967295';
+  for ch := '0' to '4' do
+    begin
+      s[1]:=ch;
+      val(s,c,l);
+      if (l<>0) then
+        halt(ord(ch)-ord('0')+b+49+h);
+    end;
+    
+  s:='4294967290';
+  for ch := '0' to '5' do
+    begin
+      s[length(s)]:=ch;
+      val(s,c,l);
+      if (l<>0) then
+        halt(ord(ch)-ord('0')+b+54+h);
+    end;
+
+  s:='4294967290';
+  for ch := '6' to '9' do
+    begin
+      s[length(s)]:=ch;
+{$ifdef cpu64}
+{$r+}
+      try
+        caught:=false;
+{$endif cpu64}
+          val(s,c,l);
+{$ifdef cpu64}
+      except on e : exception do
+        caught:=true;
+      end;
+      if not caught then
+{$else cpu64}
+      if (l=0) then
+{$endif cpu64}
+        halt(ord(ch)-ord('0')+b+54+h);
+    end;
+
+  setlength(s,length('4294967295')+1);
+  for ch2:= '1' to '3' do
+    begin
+      for b := 1 to length(s)-1 do
+        s[b]:=ch2;
+      for ch := '0' to '9' do
+        begin
+          s[length(s)]:=ch;
+{$ifdef cpu64}
+{$r+}
+          try
+            caught:=false;
+{$endif cpu64}
+            val(s,c,l);
+{$ifdef cpu64}
+          except on e : exception do
+            caught:=true;
+          end;
+          if not caught then
+{$else cpu64}
+          if (l=0) then
+{$endif cpu64}
+            halt(ord(ch2)-ord('1')+65+h);
+        end;
+    end;
+
+end;
+
+
+procedure testqword;
+const
+  h = 71;
+  hexch : array[0..15] of char='0123456789ABCDEF';
+var
+  c: qword;
+  l: longint;
+  s: shortstring;
+  b, b2: byte;
+  ch, ch2: char;
+begin
+  s:='$0fffffffffffffff';
+  for b := low(hexch) to high(hexch) do
+    begin
+      s[2]:=hexch[b];
+      val(s,c,l);
+      if (l<>0) then
+        halt(b+h);
+    end;
+    
+  s:='$fffffffffffffff0';
+  for b := low(hexch) to high(hexch) do
+    begin
+      s[length(s)]:=hexch[b];
+      val(s,c,l);
+      if (l<>0) then
+        halt(b+16+h);
+    end;
+
+  setlength(s,18);
+  s[1]:='$';
+  for b2:= 1 to high(hexch) do
+    begin
+      for b := 2 to length(s)-1 do
+        s[b]:=hexch[b2];
+      for b := low(hexch) to high(hexch) do
+        begin
+          s[length(s)]:=hexch[b];
+          val(s,c,l);
+          if (l=0) then
+            halt(b2+32+h);
+        end;
+    end;
+
+  s:='18446744073709551615';
+  for ch := '0' to '1' do
+    begin
+      s[1]:=ch;
+      val(s,c,l);
+      if (l<>0) then
+        halt(ord(ch)-ord('0')+b+49+h);
+    end;
+    
+  s:='18446744073709551615';
+  for ch := '0' to '5' do
+    begin
+      s[length(s)]:=ch;
+      val(s,c,l);
+      if (l<>0) then
+        halt(ord(ch)-ord('0')+b+54+h);
+    end;
+
+  s:='18446744073709551615';
+  for ch := '6' to '9' do
+    begin
+      s[length(s)]:=ch;
+      val(s,c,l);
+      if (l=0) then
+        halt(ord(ch)-ord('0')+b+54+h);
+    end;
+
+  setlength(s,length('18446744073709551615')+1);
+  for ch2:= '1' to '1' do
+    begin
+      for b := 1 to length(s)-1 do
+        s[b]:=ch2;
+      for ch := '0' to '9' do
+        begin
+          s[length(s)]:=ch;
+          val(s,c,l);
+          if (l=0) then
+            halt(ord(ch2)-ord('1')+61+h);
+        end;
+    end;
+
+end;
+
+begin
+  testcard;
+  testqword;
+end.

tests/test/jvm/tvalc.pp

@@ -0,0 +1,74 @@
+unit tvalc;
+
+interface
+
+{$ifdef cpujvm}
+uses
+  jdk15;
+
+{$macro on}
+{$define write:=JLSystem.fout.print}
+{$define writeln:=JLSystem.fout.println}
+{$endif}
+
+
+const
+  HasErrors : boolean = false;
+  Silent : boolean = true;
+  CheckVal : boolean = true;
+  SuccessCount : longint = 0;
+  FailCount : longint = 0;
+
+type
+  TCharSet = set of char;
+const
+  ValidNumeralsBase2 : TCHarSet = ['0'..'1'];
+  ValidNumeralsBase8 : TCHarSet = ['0'..'7'];
+  ValidNumeralsBase10 : TCHarSet = ['0'..'9'];
+  ValidNumeralsBase16 : TCHarSet = ['0'..'9','a'..'f','A'..'F'];
+  SpecialCharsFirst : TCharSet = [' ',#9,'x','X','$','&','%','+','-'];
+  SpecialCharsSecond : TCharSet = [#0];
+
+type
+
+  ValTestType =
+  (ValShouldFail,
+   ValShouldSucceed,
+   ValShouldSucceedAfterRemovingTrail);
+
+
+function Display(const s : string) : string;
+
+implementation
+
+function Display(const s : string) : string;
+var
+  res,ordval : string;
+  i : longint;
+  quoted : boolean;
+begin
+  res:='"';
+  quoted:=false;
+  for i:=1 to length(s) do
+    if ord(s[i])<32 then
+      begin
+        if quoted then
+          res:=res+'''';
+        str(ord(s[i]),ordval);
+        res:=res+'#'+ordval;
+        quoted:=false;
+      end
+    else
+      begin
+        if not quoted then
+          res:=res+'''';
+        quoted:=true;
+        res:=res+s[i];
+      end;
+  if quoted then
+    res:=res+'''';
+  res:=res+'"';
+  Display:=res;
+end;
+
+end.