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 lib => 'Calc';
59use Math::BigFloat;
60
61my ($x,$y,$z,$u);
62my $version = '1.76';	# 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::(Fast)?Calc\z/, 1);
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__END__
129&is_zero
1301:0
1310:1
132&is_one
1331:1
1340:0
135&is_positive
1361:1
137-1:0
138&is_negative
1391:0
140-1:1
141&is_nan
142abc:1
1431:0
144&is_inf
145inf:1
1460:0
147&bstr
1485:5
14910:10
150-10:-10
151abc:NaN
152'+inf':inf
153'-inf':-inf
154&bsstr
1551:1e+0
1560:0e+1
1572:2e+0
158200:2e+2
159-5:-5e+0
160-100:-1e+2
161abc:NaN
162'+inf':inf
163&babs
164-1:1
1651:1
166&bnot
167-2:1
1681:-2
169&bzero
170:0
171&bnan
172:NaN
173abc:NaN
174&bone
175:1
176'+':1
177'-':-1
178&binf
179:inf
180'+':inf
181'-':-inf
182