فهرست منبع

* fixed web bug1069
* fixed similar (and other) problems in val() for int64 and qword
(both merged from fixes branch)

Jonas Maebe 25 سال پیش
والد
کامیت
afec990176
2فایلهای تغییر یافته به همراه68 افزوده شده و 51 حذف شده
  1. 51 26
      rtl/inc/int64.inc
  2. 17 25
      rtl/inc/sstrings.inc

+ 51 - 26
rtl/inc/int64.inc

@@ -244,7 +244,8 @@
 
               { if one of the operands is greater than the result an }
               { overflow occurs                                      }
-              if checkoverflow and ((_f1>mulqword) or (f2>mulqword)) then
+              if checkoverflow and (_f1 <> 0) and (f2 <>0) and
+                 ((_f1>mulqword) or (f2>mulqword)) then
                 HandleErrorFrame(215,get_frame);
            end;
       end;
@@ -291,7 +292,8 @@
               { the q1*q2 is coded as call to mulqword }
               q3:=q1*q2;
 
-              if checkoverflow and ((q1>q3) or (q2>q3) or
+              if checkoverflow and (q1 <> 0) and (q2 <>0) and
+              ((q1>q3) or (q2>q3) or
                 { the bit 63 can be only set if we have $80000000 00000000 }
                 { and sign is true                                         }
                 ((tqwordrec(q3).high and $80000000)<>0) and
@@ -374,9 +376,13 @@
     end;
 
   Function ValInt64(Const S: ShortString; var Code: ValSInt): Int64; [public, alias:'FPC_VAL_INT64_SHORTSTR'];
+   type
+     QWordRec = packed record
+       l1,l2: longint;
+     end;
 
     var
-       u, temp, prev : Int64;
+       u, temp, prev, maxint64, maxqword : qword;
        base : byte;
        negative : boolean;
 
@@ -393,6 +399,18 @@
        exit;
      end;
 
+    { high(int64) produces 0 in version 1.0 (JM) }
+    with qwordrec(maxint64) do
+      begin
+        l1 := $ffffffff;
+        l2 := $7fffffff;
+      end;
+    with qwordrec(maxqword) do
+      begin
+        l1 := $ffffffff;
+        l2 := $ffffffff;
+      end;
+
     while Code<=Length(s) do
      begin
        case s[Code] of
@@ -404,30 +422,32 @@
        end;
        Prev:=Temp;
        Temp:=Temp*Int64(base);
-       if (Temp<prev) or (u >= base) Then
-         Begin
-           ValInt64:=0;
-           Exit
-         End;
-       prev:=temp;
+     If (u >= base) or
+        ((base = 10) and
+         (maxint64-temp < u)) or
+        ((base <> 10) and
+         (qword(maxqword-temp) < u)) or
+        (prev > maxqword div qword(base)) Then
+       Begin
+         ValInt64 := 0;
+         Exit
+       End;
        Temp:=Temp+u;
-       if prev>temp then
-         begin
-           ValInt64:=0;
-           exit;
-         end;
        inc(code);
      end;
     code:=0;
-    ValInt64:=Temp;
+    ValInt64:=int64(Temp);
     If Negative Then
       ValInt64:=-ValInt64;
   end;
 
 
   Function ValQWord(Const S: ShortString; var Code: ValSInt): QWord; [public, alias:'FPC_VAL_QWORD_SHORTSTR'];
+    type qwordrec = packed record
+      l1,l2: longint;
+    end;
     var
-       u, prev: QWord;
+       u, prev, maxqword: QWord;
        base : byte;
        negative : boolean;
   begin
@@ -435,6 +455,11 @@
     Code:=InitVal(s,negative,base);
     If Negative or (Code>length(s)) Then
       Exit;
+    with qwordrec(maxqword) do
+      begin
+        l1 := $ffffffff;
+        l2 := $ffffffff;
+      end;
     while Code<=Length(s) do
      begin
        case s[Code] of
@@ -445,19 +470,14 @@
         u:=16;
        end;
        prev := ValQWord;
-       ValQWord:=ValQWord*QWord(base);
-       If (prev>ValQWord) or (u>=base) Then
+       If (u>=base) or
+          (qword(maxqword - prev) < u) or 
+          (prev > maxqword div qword(u)) Then
          Begin
            ValQWord := 0;
            Exit
          End;
-       prev:=ValQWord;
-       ValQWord:=ValQWord+u;
-       if prev>ValQWord then
-         begin
-            ValQWord:=0;
-            exit;
-         end;
+       ValQWord:=ValQWord*QWord(base) + u;
        inc(code);
      end;
     code := 0;
@@ -466,7 +486,12 @@
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:44  michael
+  Revision 1.3  2000-07-28 12:29:49  jonas
+    * fixed web bug1069
+    * fixed similar (and other) problems in val() for int64 and qword
+      (both merged from fixes branch)
+
+  Revision 1.2  2000/07/13 11:33:44  michael
   + removed logs
  
 }

+ 17 - 25
rtl/inc/sstrings.inc

@@ -375,22 +375,16 @@ begin
      end;
      Prev := Temp;
      Temp := Temp*ValUInt(base);
-     If ((base = 10) and
-         (prev > MaxSIntValue div ValUInt(Base))) or
-        (Temp < prev) Then
+     If (u >= base) or
+        ((base = 10) and
+         (MaxSIntValue-temp < u)) or
+        ((base <> 10) and
+         (ValUInt(MaxUIntValue-Temp) < u)) or
+        (prev > ValUInt(MaxUIntValue) div ValUInt(Base)) Then
        Begin
          ValSignedInt := 0;
          Exit
        End;
-     if (u>=base) or
-        ((base = 10) and
-         (MaxSIntValue < u+temp)) or
-        ((base <> 10) and
-         (ValUInt(MaxUIntValue-Temp) < u)) then
-       begin
-         ValSignedInt:=0;
-         exit;
-       end;
      Temp:=Temp+u;
      inc(code);
    end;
@@ -432,21 +426,14 @@ begin
       u:=16;
      end;
      prev := ValUnsignedInt;
-     ValUnsignedInt:=ValUnsignedInt*ValUInt(base);
-     If prev > ValUnsignedInt Then
-      {we've had an overflow. Can't check this with
-       "If ValUnsignedInt <= (MaxUIntValue div ValUInt(Base)) Then"
-       because this division always overflows! (JM)}
-       Begin
-         ValUnsignedInt := 0;
-         Exit
-       End;
-     if (u>=base) or (ValUInt(MaxUIntValue-ValUnsignedInt) < u) then
+     If (u>=base) or
+        (ValUInt(MaxUIntValue-ValUnsignedInt) < u) or
+        (prev > (ValUInt(MaxUIntValue) div ValUInt(Base))) then
       begin
         ValUnsignedInt:=0;
         exit;
       end;
-     ValUnsignedInt:=ValUnsignedInt+u;
+     ValUnsignedInt:=ValUnsignedInt*ValUInt(base) + u;
      inc(code);
    end;
   code := 0;
@@ -571,7 +558,12 @@ end;
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:45  michael
+  Revision 1.3  2000-07-28 12:29:49  jonas
+    * fixed web bug1069
+    * fixed similar (and other) problems in val() for int64 and qword
+      (both merged from fixes branch)
+
+  Revision 1.2  2000/07/13 11:33:45  michael
   + removed logs
  
-}
+}