paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-28 08:47:20 +01:00
Code Issues Packages Projects Releases Wiki Activity

* support nf_internal to ignore currency conversion adjustments also on

Browse Source 
platforms that implement currency using a floating point type

git-svn-id: trunk@43817 -
This commit is contained in:
Jonas Maebe 2019-12-30 15:05:02 +00:00
parent 9bd33f7a45
commit 67dbd0cdb3
2 changed files with 35 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
compiler/llvm/nllvmcnv.pas
View File

@ -141,7 +141,8 @@ function tllvmtypeconvnode.first_real_to_real: tnode;
currency/comp to be compatible with the regular code generators -> currency/comp to be compatible with the regular code generators ->
call round() instead } call round() instead }
if (tfloatdef(resultdef).floattype in [s64currency,s64comp]) and if (tfloatdef(resultdef).floattype in [s64currency,s64comp]) and
not(tfloatdef(left.resultdef).floattype in [s64currency,s64comp]) then not(tfloatdef(left.resultdef).floattype in [s64currency,s64comp]) and
not(nf_internal in flags) then
begin begin
result:=ccallnode.createinternfromunit('SYSTEM','ROUND', result:=ccallnode.createinternfromunit('SYSTEM','ROUND',
ccallparanode.create(left,nil)); ccallparanode.create(left,nil));

52
compiler/ncnv.pas
View File

@ -1580,16 +1580,25 @@ implementation
if not is_currency(resultdef) then if not is_currency(resultdef) then
internalerror(200304221); internalerror(200304221);
result:=nil; result:=nil;
left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef)); if not(nf_internal in flags) then
include(left.flags,nf_is_currency); begin
{ Convert constants directly, else call Round() } left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef));
if left.nodetype=realconstn then include(left.flags,nf_is_currency);
result:=cordconstnode.create(round(trealconstnode(left).value_real),resultdef,false) { Convert constants directly, else call Round() }
if left.nodetype=realconstn then
result:=cordconstnode.create(round(trealconstnode(left).value_real),resultdef,false)
else
begin
result:=cinlinenode.create(in_round_real,false,left);
{ Internal type cast to currency }
result:=ctypeconvnode.create_internal(result,s64currencytype);
left:=nil;
end
end
else else
begin begin
result:=cinlinenode.create(in_round_real,false,left); include(left.flags,nf_is_currency);
{ Internal type cast to currency } result:=left;
result:=ctypeconvnode.create_internal(result,s64currencytype);
left:=nil; left:=nil;
end; end;
end; end;
@ -1598,20 +1607,25 @@ implementation
function ttypeconvnode.typecheck_real_to_real : tnode; function ttypeconvnode.typecheck_real_to_real : tnode;
begin begin
result:=nil; result:=nil;
if is_currency(left.resultdef) and not(is_currency(resultdef)) then if not(nf_internal in flags) then
begin begin
left:=caddnode.create(slashn,left,crealconstnode.create(10000.0,left.resultdef)); if is_currency(left.resultdef) and not(is_currency(resultdef)) then
include(left.flags,nf_is_currency); begin
typecheckpass(left); left:=caddnode.create(slashn,left,crealconstnode.create(10000.0,left.resultdef));
include(left.flags,nf_is_currency);
typecheckpass(left);
end
else
if is_currency(resultdef) and not(is_currency(left.resultdef)) then
begin
left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef));
include(left.flags,nf_is_currency);
include(flags,nf_is_currency);
typecheckpass(left);
end;
end end
else else
if is_currency(resultdef) and not(is_currency(left.resultdef)) then include(flags,nf_is_currency);
begin
left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef));
include(left.flags,nf_is_currency);
include(flags,nf_is_currency);
typecheckpass(left);
end;
end; end;