paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 14:08:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

* scale constants if possible before currency multiplications to avoid overflows, resolves #33439

Browse Source 
git-svn-id: trunk@38555 -
This commit is contained in:
florian 2018-03-17 21:33:07 +00:00
parent aa4af19027
commit b2825f2467
3 changed files with 47 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -16084,6 +16084,7 @@ tests/webtbs/tw3334.pp svneol=native#text/plain
tests/webtbs/tw3340.pp svneol=native#text/plain
tests/webtbs/tw33414.pp svneol=native#text/pascal
tests/webtbs/tw33417.pp svneol=native#text/pascal
tests/webtbs/tw33439.pp svneol=native#text/pascal
tests/webtbs/tw3348.pp svneol=native#text/plain
tests/webtbs/tw3349.pp svneol=native#text/plain
tests/webtbs/tw3351.pp svneol=native#text/plain

40
compiler/nadd.pas
View File

@ -2355,11 +2355,45 @@ implementation
end;
muln :
begin
hp:=nil;
if s64currencytype.typ=floatdef then
hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype))
begin
{ if left is a currency integer constant, we can get rid of the factor 10000 }
{ int64(...) causes a cast on currency, so it is the currency value multiplied by 10000 }
if (left.nodetype=realconstn) and (is_currency(left.resultdef)) and ((int64(trealconstnode(left).value_currency) mod 10000)=0) then
begin
{ trealconstnode expects that value_real and value_currency contain valid values }
trealconstnode(left).value_currency:=trealconstnode(left).value_currency {$ifdef FPC_CURRENCY_IS_INT64}div{$else}/{$endif} 10000;
trealconstnode(left).value_real:=trealconstnode(left).value_real/10000;
end
{ or if right is an integer constant, we can get rid of its factor 10000 }
else if (right.nodetype=realconstn) and (is_currency(right.resultdef)) and ((int64(trealconstnode(right).value_currency) mod 10000)=0) then
begin
{ trealconstnode expects that value and value_currency contain valid values }
trealconstnode(right).value_currency:=trealconstnode(right).value_currency {$ifdef FPC_CURRENCY_IS_INT64}div{$else}/{$endif} 10000;
trealconstnode(right).value_real:=trealconstnode(right).value_real/10000;
end
else
begin
hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype));
include(hp.flags,nf_is_currency);
end;
end
else
hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
include(hp.flags,nf_is_currency);
begin
{ if left is a currency integer constant, we can get rid of the factor 10000 }
if (left.nodetype=ordconstn) and (is_currency(left.resultdef)) and ((tordconstnode(left).value mod 10000)=0) then
tordconstnode(left).value:=tordconstnode(left).value div 10000
{ or if right is an integer constant, we can get rid of its factor 10000 }
else if (right.nodetype=ordconstn) and (is_currency(right.resultdef)) and ((tordconstnode(right).value mod 10000)=0) then
tordconstnode(right).value:=tordconstnode(right).value div 10000
else
begin
hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
include(hp.flags,nf_is_currency);
end
end;
result:=hp
end;
end;

9
tests/webtbs/tw33439.pp Normal file
View File

@ -0,0 +1,9 @@
Var Cur : Currency ;
Begin
Cur:=100000000000;
Cur:=Cur * 7 ;
if Cur<>700000000000 then
halt(1);
writeln('ok');
End.