瀏覽代碼

Merge of commits 43634 and 43635 for currency problems
------------------------------------------------------------------------
r43634 | pierre | 2019-12-03 16:05:30 +0000 (Tue, 03 Dec 2019) | 1 line

Use PInt64(@value_currency)^ construct to avoid internal error when starting from 3.0.4 ppcarm compiler
------------------------------------------------------------------------
--- Merging r43634 into '.':
U compiler/nadd.pas
--- Recording mergeinfo for merge of r43634 into '.':
U .
------------------------------------------------------------------------
r43635 | florian | 2019-12-03 19:31:50 +0000 (Tue, 03 Dec 2019) | 1 line

* more currency fixes, should resolve #36176
------------------------------------------------------------------------
--- Merging r43635 into '.':
G compiler/nadd.pas
U tests/test/tcurrency1.pp
--- Recording mergeinfo for merge of r43635 into '.':
G .

git-svn-id: branches/fixes_3_2@43661 -

pierre 5 年之前
父節點
當前提交
06ef4e6ca8
共有 2 個文件被更改,包括 45 次插入3 次删除
  1. 33 2
      compiler/nadd.pas
  2. 12 1
      tests/test/tcurrency1.pp

+ 33 - 2
compiler/nadd.pas

@@ -2461,14 +2461,22 @@ implementation
                       if (left.nodetype=realconstn) and (is_currency(left.resultdef)) and (not(nf_is_currency in left.flags)) and ((trunc(trealconstnode(left).value_real) mod 10000)=0) then
                         begin
                           { trealconstnode expects that value_real and value_currency contain valid values }
-                          trealconstnode(left).value_currency:=trealconstnode(left).value_currency {$ifdef FPC_CURRENCY_IS_INT64}div{$else}/{$endif} 10000;
+{$ifdef FPC_CURRENCY_IS_INT64}
+                          trealconstnode(left).value_currency:=pint64(@(trealconstnode(left).value_currency))^ div 10000;
+{$else}
+                          trealconstnode(left).value_currency:=trealconstnode(left).value_currency / 10000;
+{$endif}
                           trealconstnode(left).value_real:=trealconstnode(left).value_real/10000;
                         end
                       { or if right is an integer constant, we can get rid of its factor 10000 }
                       else if (right.nodetype=realconstn) and (is_currency(right.resultdef)) and (not(nf_is_currency in right.flags)) and ((trunc(trealconstnode(right).value_real) mod 10000)=0) then
                         begin
                           { trealconstnode expects that value and value_currency contain valid values }
-                          trealconstnode(right).value_currency:=trealconstnode(right).value_currency {$ifdef FPC_CURRENCY_IS_INT64}div{$else}/{$endif} 10000;
+{$ifdef FPC_CURRENCY_IS_INT64}
+                          trealconstnode(right).value_currency:=pint64(@(trealconstnode(right).value_currency))^ div 10000;
+{$else}
+                          trealconstnode(right).value_currency:=trealconstnode(right).value_currency / 10000;
+{$endif}
                           trealconstnode(right).value_real:=trealconstnode(right).value_real/10000;
                         end
                       else
@@ -2488,6 +2496,29 @@ implementation
                         tordconstnode(right).value:=tordconstnode(right).value div 10000
                       else
 {$endif VER3_0}
+                      if (right.nodetype=muln) and is_currency(right.resultdef) and
+                        { do not test swapped here as the internal conversions are only create as "var."*"10000" }
+                        is_currency(taddnode(right).right.resultdef)  and (taddnode(right).right.nodetype=ordconstn) and (tordconstnode(taddnode(right).right).value=10000) and
+                        is_currency(taddnode(right).left.resultdef) and (taddnode(right).left.nodetype=typeconvn) then
+                        begin
+                          hp:=taddnode(right).left.getcopy;
+                          include(hp.flags,nf_is_currency);
+                          right.free;
+                          right:=hp;
+                          hp:=nil;
+                        end
+                      else if (left.nodetype=muln) and is_currency(left.resultdef) and
+                        { do not test swapped here as the internal conversions are only create as "var."*"10000" }
+                        is_currency(taddnode(left).right.resultdef)  and (taddnode(left).right.nodetype=ordconstn) and (tordconstnode(taddnode(left).right).value=10000) and
+                        is_currency(taddnode(left).left.resultdef) and (taddnode(left).left.nodetype=typeconvn) then
+                        begin
+                          hp:=taddnode(left).left.getcopy;
+                          include(hp.flags,nf_is_currency);
+                          left.free;
+                          left:=hp;
+                          hp:=nil;
+                        end
+                      else
                         begin
                           hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false));
                           include(hp.flags,nf_is_currency);

+ 12 - 1
tests/test/tcurrency1.pp

@@ -1,4 +1,4 @@
-program tcurrency;
+program tcurrency1;
 
 { test basic mathematical operations (+,-,*,/) using currency data type }
 
@@ -69,6 +69,17 @@ begin
     writeln('Invalid currency*integer=', i*c1, ', but expected ', c2);
     halt(2);
   end;
+  i:=10000;
+  c1:=92233720368.5477;
+  c2:=922337203685477;
+  if c1*i <> c2 then begin
+    writeln('Invalid currency*integer=', c1*i, ', but expected ', c2);
+    halt(2);
+  end;
+  if i*c1 <> c2 then begin
+    writeln('Invalid integer*currency=', i*c1, ', but expected ', c2);
+    halt(2);
+  end;
   // division integer
   i := 1000;
   c1 := 123.4;