https://perl5.git.perl.org / perl5.git / blame
| Commit | Line | Data |
|---|---|---|
| 990fb837 RGS |
1 | #!/usr/bin/perl -w |
| 2 | ||
| 3 | # test that config ( trap_nan => 1, trap_inf => 1) really works/dies | |
| 4 | ||
| 5 | use strict; | |
| 6 | use Test; | |
| 7 | ||
| 8 | BEGIN | |
| 9 | { | |
| 10 | $| = 1; | |
| 11 | chdir 't' if -d 't'; | |
| 12 | unshift @INC, '../lib'; # for running manually | |
| 13 | plan tests => 29; | |
| 14 | } | |
| 15 | ||
| 16 | use Math::BigRat; | |
| 17 | ||
| 18 | my $mbi = 'Math::BigRat'; | |
| 19 | my ($cfg,$x); | |
| 20 | ||
| 21 | foreach my $class ($mbi) | |
| 22 | { | |
| 23 | # can do and defaults are okay? | |
| 24 | ok ($class->can('config')); | |
| 25 | ok ($class->config()->{trap_nan}, 0); | |
| 26 | ok ($class->config()->{trap_inf}, 0); | |
| 27 | ||
| 28 | # can set? | |
| 29 | $cfg = $class->config( trap_nan => 1 ); ok ($cfg->{trap_nan},1); | |
| 30 | ||
| 31 | # can set via hash ref? | |
| 32 | $cfg = $class->config( { trap_nan => 1 } ); ok ($cfg->{trap_nan},1); | |
| 33 | ||
| 34 | # also test that new() still works normally | |
| 35 | eval ("\$x = \$class->new('42'); \$x->bnan();"); | |
| 36 | ok ($@ =~/^Tried to set/, 1); | |
| 37 | ok ($x,42); # after new() never modified | |
| 38 | ||
| 39 | # can reset? | |
| 40 | $cfg = $class->config( trap_nan => 0 ); ok ($cfg->{trap_nan},0); | |
| 41 | ||
| 42 | # can set? | |
| 43 | $cfg = $class->config( trap_inf => 1 ); ok ($cfg->{trap_inf},1); | |
| 44 | eval ("\$x = \$class->new('4711'); \$x->binf();"); | |
| 45 | ok ($@ =~/^Tried to set/, 1); | |
| 46 | ok ($x,4711); # after new() never modified | |
| 47 | ||
| 48 | # +$x/0 => +inf | |
| 49 | eval ("\$x = \$class->new('4711'); \$x->bdiv(0);"); | |
| 50 | ok ($@ =~/^Tried to set/, 1); | |
| 51 | ok ($x,4711); # after new() never modified | |
| 52 | ||
| 53 | # -$x/0 => -inf | |
| 54 | eval ("\$x = \$class->new('-0815'); \$x->bdiv(0);"); | |
| 55 | ok ($@ =~/^Tried to set/, 1); | |
| 56 | ok ($x,-815); # after new() never modified | |
| 57 | ||
| 58 | $cfg = $class->config( trap_nan => 1 ); | |
| 59 | # 0/0 => NaN | |
| 60 | eval ("\$x = \$class->new('0'); \$x->bdiv(0);"); | |
| 61 | ok ($@ =~/^Tried to set/, 1); | |
| 62 | ok ($x,0); # after new() never modified | |
| 63 | } | |
| 64 | ||
| 65 | ############################################################################## | |
| 66 | # BigRat | |
| 67 | ||
| 68 | $cfg = Math::BigRat->config( trap_nan => 1 ); | |
| 69 | ||
| 70 | for my $trap (qw/0.1a +inf inf -inf/) | |
| 71 | { | |
| 72 | my $x = Math::BigRat->new('7/4'); | |
| 73 | ||
| 74 | eval ("\$x = \$mbi->new('$trap');"); | |
| 75 | print "# Got: $x\n" unless | |
| 76 | ok ($x,'7/4'); # never modified since it dies | |
| 77 | eval ("\$x = \$mbi->new('$trap');"); | |
| 78 | print "# Got: $x\n" unless | |
| 79 | ok ($x,'7/4'); # never modified since it dies | |
| 80 | eval ("\$x = \$mbi->new('$trap/7');"); | |
| 81 | print "# Got: $x\n" unless | |
| 82 | ok ($x,'7/4'); # never modified since it dies | |
| 83 | } | |
| 84 | ||
| 85 | # all tests done | |
| 86 |