paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 18:50:17 +02: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 ->
call round() instead }
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
result:=ccallnode.createinternfromunit('SYSTEM','ROUND',
ccallparanode.create(left,nil));

52
compiler/ncnv.pas
View File

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