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