Commit | Line | Data |
ee15d750 |
1 | #!/usr/bin/perl -w |
2 | |
dccbb853 |
3 | # test calling conventions, and :constant overloading |
ee15d750 |
4 | |
5 | use strict; |
6 | use Test; |
7 | |
8 | BEGIN |
9 | { |
10 | $| = 1; |
e745a66c |
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"; |
56d9de68 |
33 | my $tests = 161; |
34 | plan tests => $tests; |
07d34614 |
35 | if ($] < 5.006) |
36 | { |
56d9de68 |
37 | for (1..$tests) { skip (1,'Not supported on older Perls'); } |
07d34614 |
38 | exit; |
39 | } |
ee15d750 |
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); |
56d9de68 |
62 | my $version = '1.61'; # adjust manually to match latest release |
ee15d750 |
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 | { |
d614cd8b |
72 | chomp; |
ee15d750 |
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 | { |
dccbb853 |
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);"; |
ee15d750 |
89 | $rc = eval $try; |
90 | print "# Tried: '$try'\n" if !ok ($rc, $ans); |
91 | } |
92 | } |
93 | |
94 | } |
95 | |
dccbb853 |
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 , ');"; |
b3abae2a |
106 | $try .= "$class\->config()->{lib};"; |
dccbb853 |
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 | |
ee15d750 |
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 |
56d9de68 |
168 | -10:-10 |
ee15d750 |
169 | abc:NaN |
dccbb853 |
170 | '+inf':inf |
171 | '-inf':-inf |
ee15d750 |
172 | &bsstr |
173 | 1:1e+0 |
174 | 0:0e+1 |
175 | 2:2e+0 |
176 | 200:2e+2 |
56d9de68 |
177 | -5:-5e+0 |
178 | -100:-1e+2 |
179 | abc:NaN |
180 | '+inf':inf |
ee15d750 |
181 | &babs |
182 | -1:1 |
183 | 1:1 |
184 | &bnot |
185 | -2:1 |
186 | 1:-2 |
dccbb853 |
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 |