round_amount: Fix für falsches Runden bestimmter Werte

Gewisse Werte wie z.B. 33,675 wurden bei 2 Stellen falsch gerundet,
nämlich auf 33,67 anstelle von 33,68. Bei anderen Werten hingegen
funktionierte es (beispielsweise 149,175 @ 2 → 149,18).

Grund war, dass durch das Addieren von 0.5 wieder Fließkommaberechnung
und damit die Ungenauigkeit der Präsentation der IEEE-Fließkommazahlen
ins Spiel kommt. Das anschließende int() schneidet dann die
Fließkommazahl falsch ab, ungefähr so:

- Initial: 33,675
- Linksshift um 2 Dezimalstellen, also * 100: 3367,5
- Dann + 0.5 und truncate, hier passierts: +0.5 =
  3367,499999999999999999999958 (auch wenn Perl das in der Ausgabe als
  3368 darstellen würde) oder so, davon int() ergibt nun mal 3367 vor
  anschließendem Rechtsshift um 2 Dezimalstellen

Lösung ist, bis auf das Links-/Rechtsshiften um die Dezimalstellen gar
keine Fließkommaberechnung zu verwenden. Eine Variante ist, eine Stelle
mehr zu shiften als man an Genauigkeit will, dann 5 zu addieren und
anschließend auf das nächst kleinere Vielfache von 10 zu
reduzieren (durch simples Abziehen vom Modulo 10).

Um die Logik leicht einfacher zu halten, wird das Vorzeichen anfangs
ermittelt und ab dann nur noch mit dem Absolutwert der Zahl
gerechnet. Das ursprüngliche Vorzeichen wird erst nach dem erneuten
Rechtsshift, also ganz am Schluss der Berechnung, wieder hergestellt.

diff --git a/SL/Form.pm b/SL/Form.pm
index 4451440..ace85e7 100644 (file)
--- a/SL/Form.pm
+++ b/SL/Form.pm
@@ -948,24 +948,32 @@ sub parse_amount {
 }
 
 sub round_amount {
-  $main::lxdebug->enter_sub(2);
-
   my ($self, $amount, $places) = @_;
-  my $round_amount;
 
   # Rounding like "Kaufmannsrunden" (see http://de.wikipedia.org/wiki/Rundung )
 
   # Round amounts to eight places before rounding to the requested
   # number of places. This gets rid of errors due to internal floating
   # point representation.
-  $amount       = $self->round_amount($amount, 8) if $places < 8;
-  $amount       = $amount * (10**($places));
-  $round_amount = int($amount + .5 * ($amount <=> 0)) / (10**($places));
+  $amount   = $self->round_amount($amount, 8) if $places < 8;
 
-  $main::lxdebug->leave_sub(2);
+  # Remember the amount's sign but calculate in positive values only.
+  my $sign  = $amount <=> 0;
+  $amount   = abs $amount;
 
-  return $round_amount;
+  # Shift the amount left by $places+1 decimal places and truncate it
+  # to integer. Then to the integer equivalent of rounding to the next
+  # multiple of 10: first add half of it (5). Then truncate it back to
+  # the lower multiple of 10 by subtracting $amount modulo 10.
+  my $shift = 10 ** ($places + 1);
+  $amount   = int($amount * $shift) + 5;
+  $amount  -= $amount % 10;
 
+  # Lastly shift the amount back right by $places+1 decimal places and
+  # restore its sign. Then we're done.
+  $amount   = ($amount / $shift) * $sign;
+
+  return $amount;
 }
 
 sub parse_template {

diff --git a/t/form/round_amount.t b/t/form/round_amount.t
new file mode 100644 (file)
index 0000000..2ba2334
--- /dev/null
+++ b/t/form/round_amount.t
@@ -0,0 +1,65 @@
+use strict;
+use Test::More;
+
+use lib 't';
+use Support::TestSetup;
+
+Support::TestSetup::login();
+
+my $config = {};
+
+$config->{numberformat} = '1.000,00';
+
+# Positive values
+is($::form->round_amount(1.05, 2), '1.05', '1.05 @ 2');
+is($::form->round_amount(1.05, 1), '1.1',  '1.05 @ 1');
+is($::form->round_amount(1.05, 0), '1',    '1.05 @ 0');
+
+is($::form->round_amount(1.045, 2), '1.05', '1.045 @ 2');
+is($::form->round_amount(1.045, 1), '1',    '1.045 @ 1');
+is($::form->round_amount(1.045, 0), '1',    '1.045 @ 0');
+
+is($::form->round_amount(33.675, 2), '33.68', '33.675 @ 2');
+is($::form->round_amount(33.675, 1), '33.7',  '33.675 @ 1');
+is($::form->round_amount(33.675, 0), '34',    '33.675 @ 0');
+
+is($::form->round_amount(44.9 * 0.75, 2), '33.68', '44.9 * 0.75 @ 2');
+is($::form->round_amount(44.9 * 0.75, 1), '33.7',  '44.9 * 0.75 @ 1');
+is($::form->round_amount(44.9 * 0.75, 0), '34',    '44.9 * 0.75 @ 0');
+
+is($::form->round_amount(149.175, 2), '149.18', '149.175 @ 2');
+is($::form->round_amount(149.175, 1), '149.2',  '149.175 @ 1');
+is($::form->round_amount(149.175, 0), '149',    '149.175 @ 0');
+
+is($::form->round_amount(198.90 * 0.75, 2), '149.18', '198.90 * 0.75 @ 2');
+is($::form->round_amount(198.90 * 0.75, 1), '149.2',  '198.90 * 0.75 @ 1');
+is($::form->round_amount(198.90 * 0.75, 0), '149',    '198.90 * 0.75 @ 0');
+
+# Negative values
+is($::form->round_amount(-1.05, 2), '-1.05', '-1.05 @ 2');
+is($::form->round_amount(-1.05, 1), '-1.1',  '-1.05 @ 1');
+is($::form->round_amount(-1.05, 0), '-1',    '-1.05 @ 0');
+
+is($::form->round_amount(-1.045, 2), '-1.05', '-1.045 @ 2');
+is($::form->round_amount(-1.045, 1), '-1',    '-1.045 @ 1');
+is($::form->round_amount(-1.045, 0), '-1',    '-1.045 @ 0');
+
+is($::form->round_amount(-33.675, 2), '-33.68', '33.675 @ 2');
+is($::form->round_amount(-33.675, 1), '-33.7',  '33.675 @ 1');
+is($::form->round_amount(-33.675, 0), '-34',    '33.675 @ 0');
+
+is($::form->round_amount(-44.9 * 0.75, 2), '-33.68', '-44.9 * 0.75 @ 2');
+is($::form->round_amount(-44.9 * 0.75, 1), '-33.7',  '-44.9 * 0.75 @ 1');
+is($::form->round_amount(-44.9 * 0.75, 0), '-34',    '-44.9 * 0.75 @ 0');
+
+is($::form->round_amount(-149.175, 2), '-149.18', '-149.175 @ 2');
+is($::form->round_amount(-149.175, 1), '-149.2',  '-149.175 @ 1');
+is($::form->round_amount(-149.175, 0), '-149',    '-149.175 @ 0');
+
+is($::form->round_amount(-198.90 * 0.75, 2), '-149.18', '-198.90 * 0.75 @ 2');
+is($::form->round_amount(-198.90 * 0.75, 1), '-149.2',  '-198.90 * 0.75 @ 1');
+is($::form->round_amount(-198.90 * 0.75, 0), '-149',    '-198.90 * 0.75 @ 0');
+
+done_testing;
+
+1;