package TestFudge; use strict; use POSIX 'ceil', 'floor'; # Round to nearest integer sub round { my ($v, $prec) = (@_, 0); sprintf "%.$ {prec}f", $v; } sub close_enough { my ($a, $b) = @_; my $fuzz = 1e-12; abs($a-$b) < $fuzz; } BEGIN { open SAVE_STDOUT, ">&STDOUT" or die $!; open STDOUT, ">", "/dev/null" or die $!; open STDIN, "<", "/dev/null" or die $!; open 'main::DATA', "<", "/dev/null" or die $!; } END { my $N = 1; open STDOUT, ">&SAVE_STDOUT" or die $!; TEST: while () { chomp; print "# $_\n"; my ($precision, @data) = split; my $fuzz = 10**(-$precision); my $zzuf = 10**( $precision); my $total = 0; $total += $_ for @data; my (@results) = eval {main::fudge_numbers($precision, @data)}; if ($@) { print "# *** FAILED $@\n"; for (1..4) { print "not ok $N\n"; $N++; } next; } print "# => @results\n"; # Make sure there are the right number of return values { my $a = @results; my $x = @data; print $a == $x ? "ok $N\n" : "not ok $N # wrong count (expected $x, got $a)\n"; } $N++; # Make sure results sum to 100% my $rsum = 0; $rsum += round($_ * $zzuf) for @results; print $rsum == 100*$zzuf ? "ok $N\n" : join("", "not ok $N # should be 100, is ", $rsum/$zzuf, "\n"); $N++; # Make sure results have no more than the specified precision my $BAD; for (@results) { my $r = round($_, $precision); unless (close_enough($_, $r)) { my $d = $_ - $r; $BAD = "result $_ has too many digits (rounded = $r, diff $d)"; last; } } print $BAD ? "not ok $N # $BAD\n" : "ok $N\n"; $N++; # Make sure results are close to the true percentages $BAD = 0; for (0 .. $#results) { my $exact = ($data[$_] / $total) * 100; my $fudge_factor = abs($exact - $results[$_]); unless ($fudge_factor < $fuzz) { $BAD = "$exact was fudged to $results[$_]"; last; } } print $BAD ? "not ok $N # $BAD\n" : "ok $N\n"; $N++; } } "Cogito, ergo sum."; __DATA__ 0 100 100 100 1 100 100 100 2 100 100 100 0 7 7 7 1 7 7 7 2 7 7 7 1 30 30 10 1 73 1 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1 3 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1 3 2300 3400 4500 5600 6799 2 20 0 10 1 50 0 1 4 7 0 7 7 3 3 1 0 10 10 30 1 10 10 30 2 10 10 30 0 10 20 30 30 1 10 20 30 30 2 10 20 30 30 0 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 42 0 2 2 1 1 1 1 0 2 1 1 1 1 10 1 1 1 0 3570 262 3721 1498 3270 3585 3920 2740 306