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