* fixed errors with parsing negative, >$99 and invalid BCD numbers in

BCDToInt() (patch from Milla, mantis #13512)

git-svn-id: trunk@13052 -

.gitattributes

@@ -8827,6 +8827,7 @@ tests/webtbs/tw13345x.pp svneol=native#text/plain
 tests/webtbs/tw13456.pp svneol=native#text/plain
 tests/webtbs/tw1348.pp svneol=native#text/plain
 tests/webtbs/tw1351.pp svneol=native#text/plain
+tests/webtbs/tw13512.pp svneol=native#text/plain
 tests/webtbs/tw13536.pp svneol=native#text/plain
 tests/webtbs/tw13552.pp svneol=native#text/plain
 tests/webtbs/tw13553.pp svneol=native#text/plain

rtl/objpas/sysconst.pp

@@ -54,6 +54,7 @@ resourcestring
   SIntOverflow           = 'Arithmetic overflow';
   SIntfCastError         = 'Interface not supported';
   SInvalidArgIndex       = 'Invalid argument index in format "%s"';
+  SInvalidBCD            = '%x is an invalid BCD value';
   SInvalidBoolean        = '"%s" is not a valid boolean.';
   SInvalidCast           = 'Invalid type cast';
   SinvalidCurrency       = 'Invalid currency: "%s"';

rtl/objpas/sysutils/sysstr.inc

@@ -2476,13 +2476,27 @@ end;
 {    BCDToInt converts the BCD value Value to an integer   }
 
 function BCDToInt(Value: integer): integer;
-var i, j: integer;
+var i, j, digit: integer;
 begin
 result := 0;
 j := 1;
-for i := 0 to SizeOf(Value) shr 1 - 1 do begin
-   result := result + j * (Value and 15);
-   j := j * 10;
+
+for i := 0 to SizeOf(Value) shl 1 - 1 do begin
+   digit := Value and 15;
+
+   if digit > $9 then
+   begin
+       if i = 0 then
+       begin
+           if digit in [$B, $D] then j := -1
+       end
+       else raise EConvertError.createfmt(SInvalidBCD,[Value]);
+   end
+   else
+   begin
+      result := result + j * digit;
+      j := j * 10;
+      end ;
    Value := Value shr 4;
    end ;
 end ;

tests/webtbs/tw13512.pp

@@ -0,0 +1,26 @@
+{$mode objfpc}
+
+Program BCDTest;
+
+Uses SysUtils;
+
+var
+  gotexcept: boolean;
+Begin
+    WriteLn (BCDToInt ($1234)); { should retuen 1234 }
+    if (BCDToInt ($1234)) <> 1234 then
+      halt(1);
+
+    gotexcept:=false;
+    try
+      WriteLn (BCDToInt ($A0));   { Invalid value }
+    except
+      gotexcept:=true;
+    end;
+    if not gotexcept then
+      halt(1);
+
+    WriteLn (BCDToInt ($7D));   { should return -7 }
+    if (BCDToInt ($7D)) <> -7 then
+      halt(2);
+End.