* fixes for fpc_Val_SInt_ShortStr by Bart B

  + new test for fpc_Val_SInt_ShortStr
  + benchmark

rtl/inc/sstrings.inc

@@ -1157,10 +1157,19 @@ var
   temp, prev, maxPrevValue, maxNewValue: ValUInt;
   base,u : byte;
   negative : boolean;
+  SignedLower, SignedUpper: Int64;
+  UnsignedUpper: UInt64;
 begin
   fpc_Val_SInt_ShortStr := 0;
   Temp:=0;
   Code:=InitVal(s,negative,base);
+  case DestSize of
+    1: begin SignedLower:=Low(ShortInt); SignedUpper:=(High(ShortInt)); UnSignedUpper:=High(Byte) end;
+    2: begin SignedLower:=Low(SmallInt); SignedUpper:=(High(SmallInt)); UnSignedUpper:=High(Word) end;
+    4: begin SignedLower:=Low(LongInt);  SignedUpper:=(High(LongInt));  UnSignedUpper:=High(DWord) end;
+    8: begin SignedLower:=Low(Int64);    SignedUpper:=(High(Int64));    UnSignedUpper:=High(QWord) end;
+  end;
+
   if Code>length(s) then
    exit;
   if (s[Code]=#0) then
@@ -1174,6 +1183,7 @@ begin
     maxNewValue := MaxSIntValue + ord(negative)
   else
     maxNewValue := MaxUIntValue;
+
   while Code<=Length(s) do
    begin
      case s[Code] of
@@ -1186,9 +1196,17 @@ begin
      end;
      Prev := Temp;
      Temp := Temp*ValUInt(base);
+
      If (u >= base) or
         (ValUInt(maxNewValue-u) < Temp) or
-        (prev > maxPrevValue) Then
+        (prev > maxPrevValue)  or
+
+        ((base<>10) and (not negative) and ((Temp+u)>UnsignedUpper))  or
+        ((base=10) and (not negative) and (Int64(Temp+u)>SignedUpper)) or
+        (negative and (-Int64(Temp+u)<SignedLower)) or
+        ((DestSize=8) and (base<>10) and (negative) and ((Temp+u)>QWord(SignedLower)))
+
+        Then
        Begin
          fpc_Val_SInt_ShortStr := 0;
          Exit
@@ -1197,9 +1215,11 @@ begin
      inc(code);
    end;
   code := 0;
+
   fpc_Val_SInt_ShortStr := ValSInt(Temp);
   If Negative Then
     fpc_Val_SInt_ShortStr := -fpc_Val_SInt_ShortStr;
+
   If Not(Negative) and (base <> 10) Then
    {sign extend the result to allow proper range checking}
     Case DestSize of
@@ -1211,6 +1231,7 @@ begin
     End;
 end;
 
+
 {$ifndef FPC_HAS_INT_VAL_SINT_SHORTSTR}
 {$define FPC_HAS_INT_VAL_SINT_SHORTSTR}
 { we need this for fpc_Val_SInt_Ansistr and fpc_Val_SInt_WideStr because }
@@ -1267,12 +1288,13 @@ end;
        negative : boolean;
 
   const maxint64=qword($7fffffffffffffff);
+        minint64_unsigned=qword($8000000000000000);
         maxqword=qword($ffffffffffffffff);
 
   begin
-{$ifdef EXCLUDE_COMPLEX_PROCS}
+  {$ifdef EXCLUDE_COMPLEX_PROCS}
     runerror(219);
-{$else EXCLUDE_COMPLEX_PROCS}
+  {$else EXCLUDE_COMPLEX_PROCS}
     fpc_val_int64_shortstr := 0;
     Temp:=0;
     Code:=InitVal(s,negative,base);
@@ -1304,7 +1326,8 @@ end;
        Temp:=Temp*qword(base);
      If (u >= base) or
         (qword(maxnewvalue-u) < temp) or
-        (prev > maxprevvalue) Then
+        (prev > maxprevvalue) or
+        ((base<>10) and (negative) and ((Temp+u)>minint64_unsigned)) Then
        Begin
          fpc_val_int64_shortstr := 0;
          Exit
@@ -1316,7 +1339,7 @@ end;
     fpc_val_int64_shortstr:=int64(Temp);
     If Negative Then
       fpc_val_int64_shortstr:=-fpc_val_int64_shortstr;
-{$endif EXCLUDE_COMPLEX_PROCS}
+  {$endif EXCLUDE_COMPLEX_PROCS}
   end;
 
 

tests/bench/bval.pp

@@ -0,0 +1,29 @@
+const
+  bases : array[0..3] of shortint = (2,8,10,16);
+  basepref : array[0..3] of shortstring = ('%','&','','$');
+  maxlen : array[0..3] of byte = (31,10,9,7);
+  chars : shortstring = ('0123456789AbCdEf');
+  signs : shortstring = (' -');
+var
+  vals : array[0..1000] of shortstring;
+  base,len,baseindex : byte;
+  li,i,j : longint;
+  code : word;
+begin
+  for i:=low(vals) to high(vals) do
+    begin
+      baseindex:=random(4);
+      base:=bases[baseindex];
+      len:=random(maxlen[baseindex])+1;
+      vals[i]:=signs[random(2)+1]+basepref[baseindex];
+      for j:=1 to len do
+        vals[i]:=vals[i]+chars[random(base)+1];
+    end; 
+  for i:=1 to 100000 do
+    for j:=low(vals) to high(vals) do
+      begin
+        val(vals[j],li,code);
+        if code<>0 then
+          writeln(vals[j]);
+      end;
+end.

tests/test/units/system/tval6.pp

@@ -0,0 +1,203 @@
+{$mode objfpc}  //same for mode delphi
+{$h+}
+{$R+}
+
+uses
+  sysutils;
+
+var
+  ErrCount: Integer;
+  Err, Res: ValSInt;
+  Err2, Res2: Int32;
+  S: String;
+  QW: QWord;
+  I64: Int64;
+  I32: Int32;
+
+
+procedure Test(DestSize: Integer; const S: String; Expected: Boolean; ExpValue: Int64);
+var
+  I64: Int64;
+  I32: Longint;
+  I16: SmallInt;
+  I8: ShortInt;
+  B: Boolean;
+  Err: ValSInt; //Word;
+const
+  BoolStr: array[Boolean] of String = ('FALSE','TRUE');
+begin
+  write('Test: ',S,': ');
+  case DestSize of
+    1: begin Val(S, I8, Err); I64:=I8; end;
+    2: begin Val(S, I16, Err); I64:=I16; end;
+    4: begin Val(S, I32, Err); I64:=I32; end;
+    8: begin Val(S, I64, Err); end;
+    otherwise raise exception.createfmt('Invalid value for DestSize: %d',[DestSize]);
+  end;
+
+
+  B := (Err = 0);
+  if (B <> Expected) then
+  begin
+    Inc(ErrCount);
+    write(format('FAIL: S="%s", Got: %s, Expected: %s, Err: %d',[S,BoolStr[B],BoolStr[Expected],Err]));
+    if B then
+      writeln(format(', Converted to: %d',[I32]))
+    else
+      writeln(format(' ,ExpValue was: %d',[ExpValue]));
+    {$ifdef cpu64}
+    //writeln;
+    {$endif}
+    exit;
+  end;
+  if B and (I64 <> ExpValue) then
+  begin
+    Inc(ErrCount);
+    writeln(format('FAIL: S="%s", Got value: %d, ExpValue: %d.',[S,I64,ExpValue]));
+    exit;
+  end;
+  {$ifdef cpu64}
+  //writeln;
+  {$endif}
+  if Expected then
+    writeln('OK')
+  else
+    writeln('Conversion failed as expected.');
+end;
+
+
+procedure TestInt8;
+begin
+  writeln('Test 8-bit signed integers.');
+  writeln('Low(ShortInt) =',Low(ShortInt));
+  writeln('High(ShortInt)=',High(ShortInt));
+  Test(1, '127', TRUE, 127);
+  Test(1, '-128', TRUE, -128);
+  Test(1, '128', FALSE, 0);
+  Test(1, '-129', FALSE, 0);
+  Test(1, '$FF', TRUE, -1);
+  Test(1, '-$FF', FALSE, 0);
+end;
+
+procedure TestInt16;
+begin
+  writeln('Test 16-bit signed integers.');
+  writeln('Low(SmallInt) =',Low(SmallInt));
+  writeln('High(SmallInt)=',High(SmallInt));
+  //debug:=false;
+  Test(2, '32767', TRUE, 32767);
+  Test(2, '-32768', TRUE, -32768);
+  Test(2, '32768', FALSE, 0);
+  Test(2, '-32769', FALSE, 0);
+  Test(2, '$FFFF', TRUE, -1);
+  Test(2, '$10000', FALSE, 0);
+  Test(2, '-$FFFF', FALSE, 0);
+end;
+
+procedure TestInt32;
+begin
+  writeln('Test 32-bit signed integers.');
+  writeln('Low(LongInt) =',Low(LongInt));
+  writeln('High(LongInt)=',High(LongInt));
+  Test(4,'2147483647',TRUE, 2147483647);   //High(Longint)
+  Test(4,'2147483648', FALSE, 0);          //High(Longint) + 1
+  Test(4,'-2147483648', TRUE, -2147483648);
+  Test(4,'-2147483649', FALSE, 0);
+  Test(4,'$FFFFFFFF', TRUE, -1);          //High(DWord)
+  Test(4,'$100000000', False, 0);          //High(DWord) +1
+  Test(4,'$80000000', TRUE, -2147483648);
+  Test(4,'$CED4DCE3', TRUE, -824910621);
+  Test(4,'4294967295', FALSE, 0);
+  Test(4,'7795000000', FALSE, 0);
+  Test(4,'%11111111111111111111111111111111', TRUE, -1);  //High(Dword)
+  Test(4,'%100000000000000000000000000000000', FALSE, 0); //Hig(Dword) + 1
+  Test(4,'&37777777777', TRUE, -1);                       //High(Dword)
+  Test(4,'&40000000000', FALSE, 0);                       //Hig(Dword) + 1
+  Test(4,'-$123', TRUE, -291);
+  Test(4,'+$123', TRUE, 291);
+  Test(4,'xFFFFFFFF', TRUE, -1);
+  Test(4,'0xFFFFFFFF', TRUE, -1);
+  Test(4, '$FFED290A', True, -1234678);
+end;
+
+procedure TestInt64;
+var
+  H: Int64 = High(Int64); //cannot use High(Int64) as constant in Test(), compiler refuses it: valtest.pas(130,42) Error: range check error while evaluating constants (9223372036854775807 must be between -2147483648 and 2147483647)
+  L: Int64 = Low(Int64);
+begin
+  writeln('Test 64-bit signed integers.');
+  writeln('Low(Int64) =',Low(Int64));
+  writeln('High(Int64)=',High(Int64));
+  //{$ifdef CPU64}
+  {$PUSH}{$R-}
+  Test(8, '9223372036854775807', TRUE, H);
+  Test(8, '-9223372036854775808', TRUE, L);
+  Test(8, '9223372036854775808', FALSE, 0);
+  Test(8, '-9223372036854775809', FALSE, 0);
+  Test(8, '$FFFFFFFFFFFFFFFF', TRUE, -1);
+  Test(8, '-$FFFFFFFFFFFFFFFF', FALSE, 0);
+  Test(8, '2147483647', TRUE, 2147483647);
+  Test(8, '2147483648', TRUE, 2147483648);
+  Test(8, '-2147483648', TRUE, -2147483648);
+  Test(8, '-2147483649', TRUE, -2147483649);
+
+  //Test(8, '1234567890', TRUE, 1234567890);
+  //Test(8, '-1234567890', TRUE, -1234567890);
+
+  {$POP}
+  //{$endif CPU64}
+end;
+
+begin
+  {$ifdef CPU64}
+  writeln('64-bit test');
+  writeln;
+  {$endif}
+  {$ifdef CPU32}
+  writeln('32-bit test');
+  writeln;
+  {$endif}
+
+  //writeln('High(shortint): ',high(shortint), ', Low(shortint): ',low(shortint));
+  //writeln('High(smallint): ',high(smallint), ', Low(smallint): ',low(smallint));
+  //writeln('High(longint): ',high(longint), ', Low(longint): ',low(longint));
+  //writeln('High(int64): ',high(int64), ', Low(int64): ',low(int64));
+  //{$PUSH}{$R-}
+  //QW := QWord(1) shl (1*8-1) - 1;
+  //U64 := -(Int64(1) shl (1*8-1));
+  //writeln('1: ',QW, ' = ',QW.ToHexString, ', U64 = ',U64);
+  //
+  //QW := QWord(1) shl (2*8-1) - 1;
+  //U64 := -(Int64(1) shl (2*8-1));
+  //writeln('2: ',QW, ' = ',QW.ToHexString, ', U64 = ',U64);
+  //
+  //QW := QWord(1) shl (4*8-1) - 1;
+  //U64 := -(Int64(1) shl (4*8-1));
+  //writeln('4: ',QW, ' = ',QW.ToHexString, ', U64 = ',U64);
+  //
+  //QW := QWord(1) shl (8*8-1) - 1;
+  //U64 := -(Int64(1) shl (8*8-1));
+  //writeln('8: ',QW, ' = ',QW.ToHexString, ', U64 = ',U64);
+  //{$POP}
+  //
+  //
+  //EXIT;
+
+  ErrCount := 0;
+
+  TestInt8;
+  writeln;
+  TestInt16;
+  writeln;
+  TestInt32;
+  writeln;
+  TestInt64;
+  writeln;
+  writeln('Errors: ',ErrCount);
+end.
+
+
+{
+
+
+}