* fixed compilation of new str<->float code on the JVM target (patch by

    Max Nazhalov) and use that code by default on the JVM target
  * adapted JVM tests for the new str<->float code similar to how the
    generic tests were adapted

git-svn-id: trunk@25954 -

rtl/inc/flt_conv.inc

@@ -220,10 +220,13 @@ type
         RT_S128REAL  // float128
     );
 
-const
-    float_format: array [ TReal_Type ] of record
+    // JVM target: explicitly define this record type to avoid "ie2011032601"
+    TFloatFormatProfile = record
         nDig_mantissa, nDig_exp10: integer;
-    end = (
+    end;
+
+const
+    float_format: array [ TReal_Type ] of TFloatFormatProfile = (
 {
     Number of mantissa digits is dictated by [2] "IEEE 754-2008", page 32.
     N = 1 + ceiling( p * log10(2) ), where p is the number of significant

rtl/inc/flt_core.inc

@@ -925,6 +925,29 @@ begin
     round_digits := 1;
 end;
 
+(*-------------------------------------------------------
+ | do_fillchar [local]
+ |
+ | Fills string region with certain character.
+ |
+ *-------------------------------------------------------*)
+{$ifdef cpujvm}
+procedure do_fillchar( var str: shortstring; pos, count: integer; c: char );
+begin
+  while count>0 do
+    begin
+      str[pos]:=c;
+      inc(pos);
+      dec(count);
+    end;
+end;
+{$else not cpujvm}
+procedure do_fillchar( var str: shortstring; pos, count: integer; c: char ); {$ifdef grisu1_inline}inline;{$endif}
+begin
+  fillchar( str[pos], count, c );
+end;
+{$endif cpujvm}
+
 (*-------------------------------------------------------
  | try_return_fixed [local]
  |
@@ -963,8 +986,12 @@ begin
     if ( cut_digits_at < n_digits_have ) then
     begin
         // round digits
+{$ifdef cpujvm}
+        temp_round := digits;
+{$else not cpujvm}
         if ( n_digits_have > 0 ) then
             move( digits, temp_round, n_digits_have * sizeof( digits[0] ) );
+{$endif cpujvm}
         inc( fixed_dot_pos, round_digits( temp_round, n_digits_have, cut_digits_at {$ifdef GRISU1_F2A_HALF_ROUNDUP}, false {$endif} ) );
         rounded := true;
     end;
@@ -1016,7 +1043,7 @@ begin
     // Leading spaces
     if ( n_spaces > 0 ) then
     begin
-        fillchar( str[i], n_spaces, ' ' );
+        do_fillchar( str, i, n_spaces, ' ' );
         inc( i, n_spaces );
     end;
     // Sign
@@ -1046,7 +1073,7 @@ begin
     // Integer 0-padding
     if ( n_before_dot_pad0 > 0 ) then
     begin
-        fillchar( str[i], n_before_dot_pad0, '0' );
+        do_fillchar( str, i, n_before_dot_pad0, '0' );
         inc( i, n_before_dot_pad0 );
     end;
     //
@@ -1058,7 +1085,7 @@ begin
         // Pre-fraction 0-padding
         if ( n_after_dot_pad0 > 0 ) then
         begin
-            fillchar( str[i], n_after_dot_pad0, '0' );
+            do_fillchar( str, i, n_after_dot_pad0, '0' );
             inc( i, n_after_dot_pad0 );
         end;
         // Fraction significant digits
@@ -1081,7 +1108,7 @@ begin
         // Tail 0-padding
         if ( n_tail_pad0 > 0 ) then
         begin
-            fillchar( str[i], n_tail_pad0, '0' );
+            do_fillchar( str, i, n_tail_pad0, '0' );
 {$ifdef grisu1_debug}
             inc( i, n_tail_pad0 );
 {$endif grisu1_debug}
@@ -1137,7 +1164,7 @@ begin
     // Leading spaces
     if ( n_spaces > 0 ) then
     begin
-        fillchar( str[i], n_spaces, ' ' );
+        do_fillchar( str, i, n_spaces, ' ' );
         inc( i, n_spaces );
     end;
     // Sign
@@ -1170,7 +1197,7 @@ begin
     j := n_digits_req - j;
     if ( j > 0 ) then
     begin
-        fillchar( str[i], j, '0' );
+        do_fillchar( str, i, j, '0' );
         inc( i, j );
     end;
     // Exponent designator
@@ -1186,7 +1213,7 @@ begin
     j := n_digits_exp - n_exp;
     if ( j > 0 ) then
     begin
-        fillchar( str[i], j, '0' );
+        do_fillchar( str, i, j, '0' );
         inc( i, j );
     end;
     // Exponent digits
@@ -1228,7 +1255,7 @@ begin
     // Leading spaces
     if ( n_spaces > 0 ) then
     begin
-        fillchar( str[i], n_spaces, ' ' );
+        do_fillchar( str, i, n_spaces, ' ' );
         inc( i, n_spaces );
     end;
     // Sign
@@ -1241,7 +1268,11 @@ begin
         inc( i );
     end;
     // Special
-    move( spec[1], str[i], slen );
+    while slen>0 do
+      begin
+        str[i+slen-1] := spec[slen];
+        dec(slen);
+      end;
 end;
 
 {$if defined(VALREAL_80) or defined(VALREAL_128)}

rtl/java/jsystem.inc

@@ -414,7 +414,6 @@ function aligntoptr(p : pointer) : pointer;inline;
 ****************************************************************************}
 
 { Needs to be before RTTI handling }
-{$define FLOAT_ASCII_FALLBACK}
 {$i sstrings.inc}
 
 { requires sstrings.inc for initval }

tests/test/jvm/tstr.pp

@@ -74,7 +74,7 @@ begin
   { for more in-depth tests of str_real, see ../tstreal[1,2].pp }
   f := -1.12345;
 {$IFOPT E-}
-  str(f,s);
+  str(f:22,s);
   if (sizeof(extended) = 10) or
      (sizeof(extended) = 12) then
     check('-1.12345000000000E+000')
@@ -258,7 +258,7 @@ begin
   { for more in-depth tests of str_real, see ../tstreal[1,2].pp }
   f := -1.12345;
 {$IFOPT E-}
-  str(f,s);
+  str(f:22,s);
   if (sizeof(extended) = 10) or
      (sizeof(extended) = 12) then
     check('-1.12345000000000E+000')
@@ -443,7 +443,7 @@ begin
   { for more in-depth tests of str_real, see ../tstreal[1,2].pp }
   f := -1.12345;
 {$IFOPT E-}
-  str(f,s);
+  str(f:22,s);
   if sizeof(extended) = 10 then
     check('-1.12345000000000E+000')
   else if sizeof(extended) = 8 then

tests/test/jvm/tstrreal2.pp

@@ -13,7 +13,11 @@ const
   s: array[1..21] of string =
     ('10.00000000000000000',
      '1.00000000000000000',
+{$ifdef FPC_HAS_TYPE_EXTENDED}
      '0.10000000000000000',
+{$else FPC_HAS_TYPE_EXTENDED}
+     '0.10000000000000001',
+{$endif FPC_HAS_TYPE_EXTENDED}
      '0.01000000000000000',
      '0.00100000000000000',
      '0.00010000000000000',
@@ -40,7 +44,7 @@ var
   lenadjust: longint;
 begin
   if sizeof(extended) = 8 then
-    lenadjust := 2
+    lenadjust := 0
   else
     lenadjust := 0;
   e := 10.0;