Browse Source

rtl: added val(s,bool,code), fixed range check error MinInteger

mattias 6 years ago
parent
commit
ac757558fe
2 changed files with 24 additions and 3 deletions
  1. 1 1
      packages/rtl/math.pas
  2. 23 2
      packages/rtl/system.pas

+ 1 - 1
packages/rtl/math.pas

@@ -20,7 +20,7 @@ uses
   SysUtils;
 
 const
-  MinInteger = -$10000000000000;
+  MinInteger = -$fffffffffffff-1;
   MaxInteger = $fffffffffffff;
   MinDouble  =  5.0e-324;
   MaxDouble  =  1.7e+308;

+ 23 - 2
packages/rtl/system.pas

@@ -287,6 +287,7 @@ procedure val(const S: String; out W : word; out Code : Integer); overload;
 procedure val(const S: String; out I : integer; out Code : Integer); overload;
 procedure val(const S: String; out C : Cardinal; out Code: Integer); overload;
 procedure val(const S: String; out d : double; out Code : Integer); overload;
+procedure val(const S: String; out b : boolean; out Code: Integer); overload;
 function StringOfChar(c: Char; l: NativeInt): String;
 
 {*****************************************************************************
@@ -480,7 +481,6 @@ function valint(const S: String; MinVal, MaxVal: NativeInt; out Code: Integer):
 var
   x: double;
 begin
-  Code:=0;
   x:=Number(S);
   if isNaN(x) then
     case copy(s,1,1) of
@@ -496,7 +496,10 @@ begin
   else if (x<MinVal) or (x>MaxVal) then
     Code:=2
   else
+    begin
     Result:=Trunc(x);
+    Code:=0;
+    end;
 end;
 
 procedure val(const S: String; out NI : NativeInt; out Code: Integer);
@@ -508,12 +511,14 @@ procedure val(const S: String; out NI: NativeUInt; out Code: Integer);
 var
   x : double;
 begin
-  Code:=0;
   x:=Number(S);
   if isNaN(x) or (X<>Int(X)) or (X<0) then
     Code:=1
   else
+    begin
+    Code:=0;
     NI:=Trunc(x);
+    end;
 end;
 
 procedure val(const S: String; out SI : ShortInt; out Code: Integer);
@@ -560,6 +565,22 @@ begin
     end;
 end;
 
+procedure val(const S: String; out b: boolean; out Code: Integer);
+begin
+  if SameText(S,'true') then
+    begin
+    Code:=0;
+    b:=true;
+    end
+  else if SameText(S,'false') then
+    begin
+    Code:=0;
+    b:=false;
+    end
+  else
+    Code:=1;
+end;
+
 function upcase(c : char) : char; assembler;
 
 asm