#!/usr/bin/perl -w use strict; use POSIX qw(floor); my $fail = 0; my $incomplete = 0; my $bugged = 0; my $pi = 4 * atan2 1, 1; sub check_mul { my ($a, $b, $r) = @_; $b = $b / 256; my $m = floor ($a * $b); if ($m > (1 << 15) - 1 || $m < -(1 << 15)) { print "overflow $a * $b = $r ($m)\n"; } elsif ($m == $r) { print "pass $a * $b = $r\n"; } else { print "fail $a * $b = $r ($m)\n"; $fail = 1; } } sub check_mul_f824 { use bignum; my ($a, $b, $r) = @_; my ($ha, $hb, $hr) = (sprintf ("%x", $a), sprintf ("%x", $b), sprintf ("%x", $r)); $a = $a / (1 << 24); $b = $b / (1 << 24); $r = $r / (1 << 24); my $m = floor ($a * $b * (1 << 24)) / (1 << 24); if ($m > (1 << 7) - 1 || $m < -(1 << 7)) { print "overflow $a * $b = $r ($m) | $ha $hb $hr\n"; } elsif ($m == $r) { print "pass $a * $b = $r | $ha $hb $hr\n"; } else { print "fail $a * $b = $r ($m) | $ha $hb $hr\n"; $fail = 1; } } sub check_cos { my ($a, $r) = @_; my ($ha, $hr) = (sprintf ("%x", $a), sprintf ("%x", $r)); $a = $a / (1 << 24) * 2 * $pi; $r = $r / (1 << 24); my $c = floor (cos ($a) * (1 << 24)) / (1 << 24); if ($c == $r) { print "pass cos $a = $r | $ha $hr\n"; } else { print "fail cos $a = $r ($c) | $ha $hr\n"; $fail = 1; } } sub check_sin { my ($a, $r) = @_; my ($ha, $hr) = (sprintf ("%x", $a), sprintf ("%x", $r)); $a = $a / (1 << 24) * 2 * $pi; $r = $r / (1 << 24); my $s = floor (sin ($a) * (1 << 24)) / (1 << 24); if ($s == $r) { print "pass sin $a = $r | $ha $hr\n"; } else { print "fail sin $a = $r ($s) | $ha $hr\n"; $fail = 1; } } while (<>) { chomp; if (/^m (-?\d+) (\d+)$/) { $incomplete++; my ($a, $b) = ($1, $2); $_ = <>; chomp; next unless (/^r (-?\d+)$/); my $r = $1; $_ = <>; chomp; next unless (/^R (-?\d+)$/); my $R = $1; check_mul $a, $b, $r; check_mul -$a, $b, $R; $incomplete--; } if (/^A (-?\d+)$/) { $bugged = 1; $incomplete++; my $a = $1; $_ = <>; chomp; next unless (/^B (-?\d+)$/); my $b = $1; $_ = <>; chomp; next unless (/^r (-?\d+)$/); my $r = $1; check_mul_f824 $a, $b, $r; $_ = <>; chomp; next unless (/^r (-?\d+)$/); $r = $1; check_mul_f824 -$a, $b, $r; $_ = <>; chomp; next unless (/^r (-?\d+)$/); $r = $1; check_mul_f824 $a, -$b, $r; $_ = <>; chomp; next unless (/^r (-?\d+)$/); $r = $1; check_mul_f824 -$a, -$b, $r; $incomplete--; } if (/^c (-?\d+)$/) { $bugged = 1; $incomplete++; my $c = $1; $_ = <>; chomp; next unless (/^r (-?\d+)$/); my $r = $1; check_cos $c, $r; $_ = <>; chomp; next unless (/^r (-?\d+)$/); $r = $1; check_sin $c, $r; $incomplete--; } } print "WARNING: test bugged\n" if ($bugged); if ($incomplete) { print "$incomplete incomplete tests\n"; } if ($fail) { print "test failled\n"; exit 1; } else { print "test passed\n"; exit 0; }