* catch invalid floating point operations in TextToFloat (mantis #24197)

git-svn-id: trunk@24105 -
This commit is contained in:
Jonas Maebe 2013-04-01 11:50:49 +00:00
parent 669a16c98d
commit 25ebb36103
3 changed files with 43 additions and 18 deletions

1
.gitattributes vendored
View File

@ -13292,6 +13292,7 @@ tests/webtbs/tw2397.pp svneol=native#text/plain
tests/webtbs/tw24007.pp svneol=native#text/plain tests/webtbs/tw24007.pp svneol=native#text/plain
tests/webtbs/tw2409.pp svneol=native#text/plain tests/webtbs/tw2409.pp svneol=native#text/plain
tests/webtbs/tw24131.pp svneol=native#text/plain tests/webtbs/tw24131.pp svneol=native#text/plain
tests/webtbs/tw24197.pp svneol=native#text/plain
tests/webtbs/tw2421.pp svneol=native#text/plain tests/webtbs/tw2421.pp svneol=native#text/plain
tests/webtbs/tw2423.pp svneol=native#text/plain tests/webtbs/tw2423.pp svneol=native#text/plain
tests/webtbs/tw2425.pp svneol=native#text/plain tests/webtbs/tw2425.pp svneol=native#text/plain

View File

@ -1084,27 +1084,38 @@ Begin
P:=Pos(FormatSettings.DecimalSeparator,S); P:=Pos(FormatSettings.DecimalSeparator,S);
If (P<>0) Then If (P<>0) Then
S[P] := '.'; S[P] := '.';
case ValueType of try
fvCurrency: case ValueType of
fvCurrency:
{$ifdef FPC_HAS_STR_CURRENCY} {$ifdef FPC_HAS_STR_CURRENCY}
Val(S,Currency(Value),E); Val(S,Currency(Value),E);
{$else FPC_HAS_STR_CURRENCY} {$else FPC_HAS_STR_CURRENCY}
begin begin
// needed for platforms where Currency = Int64 // needed for platforms where Currency = Int64
Val(S,TempValue,E); Val(S,TempValue,E);
Currency(Value) := TempValue; Currency(Value) := TempValue;
end; end;
{$endif FPC_HAS_STR_CURRENCY} {$endif FPC_HAS_STR_CURRENCY}
fvExtended: fvExtended:
Val(S,Extended(Value),E); Val(S,Extended(Value),E);
fvDouble: fvDouble:
Val(S,Double(Value),E); Val(S,Double(Value),E);
fvSingle: fvSingle:
Val(S,Single(Value),E); Val(S,Single(Value),E);
fvComp: fvComp:
Val(S,Comp(Value),E); Val(S,Comp(Value),E);
fvReal: fvReal:
Val(S,Real(Value),E); Val(S,Real(Value),E);
end;
{ on x87, a floating point exception may be pending in case of an invalid
input value -> trigger it now }
{$ifdef cpux86}
asm
fwait
end;
{$endif}
except
E:=1;
end; end;
Result:=(E=0); Result:=(E=0);
End; End;

13
tests/webtbs/tw24197.pp Normal file
View File

@ -0,0 +1,13 @@
{$mode objfpc}
uses
SysUtils;
begin
try
StrToCurr('46198723647893247891326489732164897321649');
except
on EConverterror do
halt(0)
end;
end.