tests/expressions/randist/compare.pl

   1 #! /usr/bin/perl -w
   2
   3 use strict;
   4 use warnings 'all';
   5
   6 my ($epsilon) = 1;
   7
   8 open (EXPECTED, '<', $ARGV[0]) or die "$ARGV[0]: open: $!\n";
   9 open (ACTUAL, '<', $ARGV[1]) or die "$ARGV[1]: open: $!\n";
  10
  11 my ($errors) = 0;
  12 LINE: for (;;) {
  13     my $a = <EXPECTED>;
  14     my $b = <ACTUAL>;
  15
  16     last if !defined $a && !defined $b;
  17     die "$ARGV[0]:$.: unexpected end of file\n" if !defined $a;
  18     die "$ARGV[1]:$.: unexpected end of file\n" if !defined $b;
  19
  20     my (@a) = split (' ', $a);
  21     my (@b) = split (' ', $b);
  22     die "$ARGV[1]:$.: contains ". scalar (@b) . " fields but should "
  23       . "contain " . scalar (@a) . "\n"
  24         if $#a != $#b;
  25     foreach my $i (0...$#a) {
  26         die "$ARGV[1]:$.: unexpected number of decimals\n"
  27           if count_decimals ($a[$i]) != count_decimals ($b[$i]);
  28
  29         my ($an) = to_int ($a[$i]);
  30         my ($bn) = to_int ($b[$i]);
  31         if ($an ne $bn && ($bn < $an - $epsilon || $bn > $an + $epsilon)) {
  32             $errors++;
  33             if ($errors > 5) {
  34                 print "$ARGV[1]: Additional differences suppressed.\n";
  35                 last LINE;
  36             }
  37             print "$ARGV[1]:$.: Values differ from $ARGV[0]:$.\n";
  38             print "Expected:\n", $a;
  39             print "Calculated:\n", $b;
  40         }
  41     }
  42 }
  43 exit ($errors > 0);
  44
  45 sub count_decimals {
  46     my ($s) = @_;
  47     return length (substr ($s, index ($s, '.')));
  48 }
  49
  50 sub to_int {
  51     local ($_) = @_;
  52     s/\.//;
  53     return $_;
  54 }