Merge branch 'val_sint' into main

rtl/inc/sstrings.inc

@@ -1154,13 +1154,42 @@ end;
 
 Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; [public, alias:'FPC_VAL_SINT_SHORTSTR']; compilerproc;
 var
-  temp, prev, maxPrevValue, maxNewValue: ValUInt;
+  temp, prev, maxPrevValue: ValUInt;
   base,u : byte;
-  negative : boolean;
+  negative: boolean;
+  UnsignedUpperLimit: ValUInt;
+const
+  ValueArray : array['0'..'f'] of byte = (0,1,2,3,4,5,6,7,8,9,$FF,$FF,$FF,$FF,$FF,$FF,$FF,10,11,12,13,14,15,
+                                          $FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,
+                                          10,11,12,13,14,15);
 begin
   fpc_Val_SInt_ShortStr := 0;
   Temp:=0;
   Code:=InitVal(s,negative,base);
+
+  if (base=10) or negative then
+    begin //always limit to either Low(DestType) or High(DestType)
+      case DestSize of
+        1: UnsignedUpperLimit := ValUInt(High(ShortInt))+Ord(negative);
+        2: UnsignedUpperLimit := ValUInt(High(SmallInt))+Ord(negative);
+        4: UnsignedUpperLimit := ValUInt(High(LongInt))+Ord(negative);
+        {$ifdef CPU64}
+        8: UnsignedUpperLimit := ValUInt(High(Int64))+Ord(negative);
+        {$endif CPU64}
+      end;
+    end
+  else
+    begin //not decimal and not negative
+      case DestSize of
+        1: UnsignedUpperLimit := High(Byte);
+        2: UnsignedUpperLimit := High(Word);
+        4: UnsignedUpperLimit := High(DWord);
+        {$ifdef CPU64}
+        8: UnsignedUpperLimit := High(UInt64);
+        {$endif CPU64}
+      end;
+    end;
+
   if Code>length(s) then
    exit;
   if (s[Code]=#0) then
@@ -1169,26 +1198,25 @@ begin
         Code:=0;
       exit;
     end;
+
   maxPrevValue := ValUInt(MaxUIntValue) div ValUInt(Base);
-  if (base = 10) then
-    maxNewValue := MaxSIntValue + ord(negative)
-  else
-    maxNewValue := MaxUIntValue;
+
   while Code<=Length(s) do
    begin
-     case s[Code] of
-       '0'..'9' : u:=Ord(S[Code])-Ord('0');
-       'A'..'F' : u:=Ord(S[Code])-(Ord('A')-10);
-       'a'..'f' : u:=Ord(S[Code])-(Ord('a')-10);
+     u:=16;
+     case s[code] of
+       '0'..'f' : u:=ValueArray[S[Code]];
        #0 : break;
      else
-      u:=16;
+       ;
      end;
+
      Prev := Temp;
      Temp := Temp*ValUInt(base);
+
      If (u >= base) or
-        (ValUInt(maxNewValue-u) < Temp) or
-        (prev > maxPrevValue) Then
+        (prev > maxPrevValue)
+        or ((Temp)>(UnsignedUpperLimit-u)) Then
        Begin
          fpc_Val_SInt_ShortStr := 0;
          Exit
@@ -1197,9 +1225,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 +1241,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 +1298,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 +1336,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 +1349,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;
 
 

rtl/objpas/sysutils/sysstr.inc

@@ -960,14 +960,12 @@ end;
 function TryStrToInt(const s: string; out i : Longint) : boolean;
 var
   Error : word;
-  li : Int64;
 begin
-  Val(s, li, Error);
-  TryStrToInt:=(Error=0) and (li<=High(DWord)) and (li>=Low(Longint));
-  if TryStrToInt then
-    i:=li;
+  Val(s, i, Error);
+  TryStrToInt:=(Error=0)
 end;
 
+
 {   StrToInt converts the string S to an integer value,
     if S does not represent a valid integer value EConvertError is raised  }
 function StrToInt(const S: string): Longint;

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/tbs/tb0336.pp

@@ -35,11 +35,7 @@ begin
      do_error(3);
    s:='2147483648';
    val(s,l,code);
-{$ifdef CPU64}
-   if code<>0 then
-{$else CPU64}
    if code=0 then
-{$endif CPU64}
      do_error(4);
    s:='-2147483648';
    val(s,l,code);
@@ -47,10 +43,6 @@ begin
      do_error(5);
    s:='-2147483649';
    val(s,l,code);
-{$ifdef CPU64}
-   if code<>0 then
-{$else CPU64}
    if code=0 then
-{$endif CPU64}
      do_error(6);
 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.
+
+
+{
+
+
+}