1#!/usr/bin/perl -w 2 3# test calling conventions, and :constant overloading 4 5use strict; 6use Test; 7 8BEGIN 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 = 160; 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 42package Math::BigInt::Test; 43 44use Math::BigInt; 45use vars qw/@ISA/; 46@ISA = qw/Math::BigInt/; # child of MBI 47use overload; 48 49package Math::BigFloat::Test; 50 51use Math::BigFloat; 52use vars qw/@ISA/; 53@ISA = qw/Math::BigFloat/; # child of MBI 54use overload; 55 56package main; 57 58use Math::BigInt; 59use Math::BigFloat; 60 61my ($x,$y,$z,$u); 62my $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 69my ($func,@args,$ans,$rc,$class,$try); 70while (<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# XXX TODO this test does not work/fail. 99# test whether use Math::BigInt qw/version/ works 100#$try = "use $class ($version.'1');"; 101#$try .= ' $x = $class->new(123); $x = "$x";'; 102#eval $try; 103#ok_undef ( $x ); # should result in error! 104 105# test whether fallback to calc works 106$try = "use $class ($version,'lib','foo, bar , ');"; 107$try .= "$class\->config()->{lib};"; 108$ans = eval $try; 109ok ( $ans, "Math::BigInt::Calc"); 110 111# test whether constant works or not, also test for qw($version) 112# bgcd() is present in subclass, too 113$try = "use Math::BigInt ($version,'bgcd',':constant');"; 114$try .= ' $x = 2**150; bgcd($x); $x = "$x";'; 115$ans = eval $try; 116ok ( $ans, "1427247692705959881058285969449495136382746624"); 117 118# test wether Math::BigInt::Scalar via use works (w/ dff. spellings of calc) 119$try = "use $class ($version,'lib','Scalar');"; 120$try .= ' $x = 2**10; $x = "$x";'; 121$ans = eval $try; ok ( $ans, "1024"); 122$try = "use $class ($version,'LiB','$class\::Scalar');"; 123$try .= ' $x = 2**10; $x = "$x";'; 124$ans = eval $try; ok ( $ans, "1024"); 125 126# all done 127 128############################################################################### 129# Perl 5.005 does not like ok ($x,undef) 130 131sub ok_undef 132 { 133 my $x = shift; 134 135 ok (1,1) and return if !defined $x; 136 ok ($x,'undef'); 137 } 138 139__END__ 140&is_zero 1411:0 1420:1 143&is_one 1441:1 1450:0 146&is_positive 1471:1 148-1:0 149&is_negative 1501:0 151-1:1 152&is_nan 153abc:1 1541:0 155&is_inf 156inf:1 1570:0 158&bstr 1595:5 16010:10 161-10:-10 162abc:NaN 163'+inf':inf 164'-inf':-inf 165&bsstr 1661:1e+0 1670:0e+1 1682:2e+0 169200:2e+2 170-5:-5e+0 171-100:-1e+2 172abc:NaN 173'+inf':inf 174&babs 175-1:1 1761:1 177&bnot 178-2:1 1791:-2 180&bzero 181:0 182&bnan 183:NaN 184abc:NaN 185&bone 186:1 187'+':1 188'-':-1 189&binf 190:inf 191'+':inf 192'-':-inf 193