瀏覽代碼

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

git-svn-id: trunk@22014 -

Jonas Maebe 13 年之前
父節點
當前提交
3c1b82f9a0
共有 3 個文件被更改,包括 36 次插入7 次删除
  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.
+