Browse Source

* don't add value transformations for internal type casts from/to currency
(mantis #22561)

git-svn-id: trunk@22014 -

Jonas Maebe 13 năm trước cách đây
mục cha
commit
3c1b82f9a0
3 tập tin đã thay đổi với 36 bổ sung7 xóa
  1. 1 0
      .gitattributes
  2. 24 7
      compiler/ncnv.pas
  3. 11 0
      tests/webtbs/tw22561.pp

+ 1 - 0
.gitattributes

@@ -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

+ 24 - 7
compiler/ncnv.pas

@@ -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 - 0
tests/webtbs/tw22561.pp

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