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"; |
dccbb853 |
33 | plan tests => 141; |
ee15d750 |
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); |
e745a66c |
56 | my $version = '1.46'; # adjust manually to match latest release |
ee15d750 |
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 | { |
d614cd8b |
66 | chomp; |
ee15d750 |
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 | { |
dccbb853 |
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);"; |
ee15d750 |
83 | $rc = eval $try; |
84 | print "# Tried: '$try'\n" if !ok ($rc, $ans); |
85 | } |
86 | } |
87 | |
88 | } |
89 | |
dccbb853 |
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 , ');"; |
b3abae2a |
100 | $try .= "$class\->config()->{lib};"; |
dccbb853 |
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 | |
ee15d750 |
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 |
dccbb853 |
163 | '+inf':inf |
164 | '-inf':-inf |
ee15d750 |
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 |
dccbb853 |
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 |