lib/Math/BigInt/t/calling.t

   1 #!/usr/bin/perl -w
   2
   3 # test calling conventions, and :constant overloading
   4
   5 use strict;
   6 use Test;
   7
   8 BEGIN
   9   {
  10   $| = 1;
  11   # to locate the testing files
  12   my $location = $0; $location =~ s/calling.t//i;
  13   if ($ENV{PERL_CORE})
  14     {
  15     # testing with the core distribution
  16     @INC = qw(../lib);
  17     }
  18   else
  19     {
  20     unshift @INC, '../lib';
  21     }
  22   if (-d 't')
  23     {
  24     chdir 't';
  25     require File::Spec;
  26     unshift @INC, File::Spec->catdir(File::Spec->updir, $location);
  27     }
  28   else
  29     {
  30     unshift @INC, $location;
  31     }
  32   print "# INC = @INC\n";
  33   my $tests = 161;
  34   plan tests => $tests;
  35   if ($] < 5.006)
  36     {
  37     for (1..$tests) { skip (1,'Not supported on older Perls'); }
  38     exit;
  39     }
  40   }
  41
  42 package Math::BigInt::Test;
  43
  44 use Math::BigInt;
  45 use vars qw/@ISA/;
  46 @ISA = qw/Math::BigInt/;                # child of MBI
  47 use overload;
  48
  49 package Math::BigFloat::Test;
  50
  51 use Math::BigFloat;
  52 use vars qw/@ISA/;
  53 @ISA = qw/Math::BigFloat/;              # child of MBI
  54 use overload;
  55
  56 package main;
  57
  58 use Math::BigInt;
  59 use Math::BigFloat;
  60
  61 my ($x,$y,$z,$u);
  62 my $version = '1.61';   # adjust manually to match latest release
  63
  64 ###############################################################################
  65 # check whether op's accept normal strings, even when inherited by subclasses
  66
  67 # do one positive and one negative test to avoid false positives by "accident"
  68
  69 my ($func,@args,$ans,$rc,$class,$try);
  70 while (<DATA>)
  71   {
  72   chomp;
  73   next if /^#/; # skip comments
  74   if (s/^&//)
  75     {
  76     $func = $_;
  77     }
  78   else
  79     {
  80     @args = split(/:/,$_,99);
  81     $ans = pop @args;
  82     foreach $class (qw/
  83       Math::BigInt Math::BigFloat Math::BigInt::Test Math::BigFloat::Test/)
  84       {
  85       $try = "'$args[0]'";                      # quote it
  86       $try = $args[0] if $args[0] =~ /'/;       # already quoted
  87       $try = '' if $args[0] eq '';              # undef, no argument
  88       $try = "$class\->$func($try);";
  89       $rc = eval $try;
  90       print "# Tried: '$try'\n" if !ok ($rc, $ans);
  91       }
  92     }
  93
  94   }
  95
  96 $class = 'Math::BigInt';
  97
  98 # test whether use Math::BigInt qw/version/ works
  99 $try = "use $class ($version.'1');";
 100 $try .= ' $x = $class->new(123); $x = "$x";';
 101 eval $try;
 102 ok_undef ( $_ );               # should result in error!
 103
 104 # test whether fallback to calc works
 105 $try = "use $class ($version,'lib','foo, bar , ');";
 106 $try .= "$class\->config()->{lib};";
 107 $ans = eval $try;
 108 ok ( $ans, "Math::BigInt::Calc");
 109
 110 # test whether constant works or not, also test for qw($version)
 111 # bgcd() is present in subclass, too
 112 $try = "use Math::BigInt ($version,'bgcd',':constant');";
 113 $try .= ' $x = 2**150; bgcd($x); $x = "$x";';
 114 $ans = eval $try;
 115 ok ( $ans, "1427247692705959881058285969449495136382746624");
 116
 117 # test wether Math::BigInt::Scalar via use works (w/ dff. spellings of calc)
 118 $try = "use $class ($version,'lib','Scalar');";
 119 $try .= ' $x = 2**10; $x = "$x";';
 120 $ans = eval $try; ok ( $ans, "1024");
 121 $try = "use $class ($version,'LiB','$class\::Scalar');";
 122 $try .= ' $x = 2**10; $x = "$x";';
 123 $ans = eval $try; ok ( $ans, "1024");
 124
 125 # test wether calc => undef (array element not existing) works
 126 # no longer supported
 127 #$try = "use $class ($version,'LIB');";
 128 #$try = "require $class; $class\::import($version,'CALC');";
 129 #$try .= " \$x = $class\->new(2)**10; \$x = ".'"$x";';
 130 #print "$try\n";
 131 #$ans = eval $try; ok ( $ans, 1024);
 132
 133 # all done
 134
 135 ###############################################################################
 136 # Perl 5.005 does not like ok ($x,undef)
 137
 138 sub ok_undef
 139   {
 140   my $x = shift;
 141
 142   ok (1,1) and return if !defined $x;
 143   ok ($x,'undef');
 144   }
 145
 146 __END__
 147 &is_zero
 148 1:0
 149 0:1
 150 &is_one
 151 1:1
 152 0:0
 153 &is_positive
 154 1:1
 155 -1:0
 156 &is_negative
 157 1:0
 158 -1:1
 159 &is_nan
 160 abc:1
 161 1:0
 162 &is_inf
 163 inf:1
 164 0:0
 165 &bstr
 166 5:5
 167 10:10
 168 -10:-10
 169 abc:NaN
 170 '+inf':inf
 171 '-inf':-inf
 172 &bsstr
 173 1:1e+0
 174 0:0e+1
 175 2:2e+0
 176 200:2e+2
 177 -5:-5e+0
 178 -100:-1e+2
 179 abc:NaN
 180 '+inf':inf
 181 &babs
 182 -1:1
 183 1:1
 184 &bnot
 185 -2:1
 186 1:-2
 187 &bzero
 188 :0
 189 &bnan
 190 :NaN
 191 abc:NaN
 192 &bone
 193 :1
 194 '+':1
 195 '-':-1
 196 &binf
 197 :inf
 198 '+':inf
 199 '-':-inf