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

* don't add value transformations for internal type casts from/to currency

Browse Source 
(mantis #22561)

git-svn-id: trunk@22014 -
This commit is contained in:
Jonas Maebe 2012-08-05 15:36:44 +00:00
parent e81ba0f82e
commit 3c1b82f9a0
3 changed files with 36 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -12772,6 +12772,7 @@ tests/webtbs/tw22344.pp svneol=native#text/plain
tests/webtbs/tw2242.pp svneol=native#text/plain
tests/webtbs/tw2250.pp svneol=native#text/plain
tests/webtbs/tw22502.pp svneol=native#text/plain
tests/webtbs/tw22561.pp svneol=native#text/plain
tests/webtbs/tw2259.pp svneol=native#text/plain
tests/webtbs/tw2260.pp svneol=native#text/plain
tests/webtbs/tw2266.pp svneol=native#text/plain

31
compiler/ncnv.pas
View File

@ -1328,13 +1328,15 @@ implementation
if left.nodetype=ordconstn then
begin
v:=tordconstnode(left).value;
if is_currency(resultdef) then
if is_currency(resultdef) and
not(nf_internal in flags) then
v:=v*10000;
if (resultdef.typ=pointerdef) then
result:=cpointerconstnode.create(TConstPtrUInt(v.uvalue),resultdef)
else
begin
if is_currency(left.resultdef) then
if is_currency(left.resultdef) and
not(nf_internal in flags) then
v:=v div 10000;
result:=cordconstnode.create(v,resultdef,false);
end;
@ -1346,18 +1348,25 @@ implementation
result:=cpointerconstnode.create(v.uvalue,resultdef)
else
begin
if is_currency(resultdef) then
if is_currency(resultdef) and
not(nf_internal in flags) then
v:=v*10000;
result:=cordconstnode.create(v,resultdef,false);
end;
end
else
begin
if (is_currency(resultdef) or
is_currency(left.resultdef)) and
(nf_internal in flags) then
begin
include(flags,nf_is_currency)
end
{ multiply by 10000 for currency. We need to use getcopy to pass
the argument because the current node is always disposed. Only
inserting the multiply in the left node is not possible because
it'll get in an infinite loop to convert int->currency }
if is_currency(resultdef) then
else if is_currency(resultdef) then
begin
result:=caddnode.create(muln,getcopy,cordconstnode.create(10000,resultdef,false));
include(result.flags,nf_is_currency);
@ -1379,19 +1388,27 @@ implementation
if left.nodetype=ordconstn then
begin
rv:=tordconstnode(left).value;
if is_currency(resultdef) then
if is_currency(resultdef) and
not(nf_internal in flags) then
rv:=rv*10000.0
else if is_currency(left.resultdef) then
else if is_currency(left.resultdef) and
not(nf_internal in flags) then
rv:=rv/10000.0;
result:=crealconstnode.create(rv,resultdef);
end
else
begin
if (is_currency(resultdef) or
is_currency(left.resultdef)) and
(nf_internal in flags) then
begin
include(flags,nf_is_currency)
end
{ multiply by 10000 for currency. We need to use getcopy to pass
the argument because the current node is always disposed. Only
inserting the multiply in the left node is not possible because
it'll get in an infinite loop to convert int->currency }
if is_currency(resultdef) then
else if is_currency(resultdef) then
begin
result:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resultdef));
include(result.flags,nf_is_currency);

11
tests/webtbs/tw22561.pp Normal file
View File

@ -0,0 +1,11 @@
{ %opt=-gt }
{ %norun }
procedure test;
var c: currency;
begin
end;
begin
end.