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"; |
9b924220 |
33 | my $tests = 160; |
56d9de68 |
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 | |
9b924220 |
98 | # XXX TODO this test does not work/fail. |
dccbb853 |
99 | # test whether use Math::BigInt qw/version/ works |
9b924220 |
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! |
dccbb853 |
104 | |
105 | # test whether fallback to calc works |
106 | $try = "use $class ($version,'lib','foo, bar , ');"; |
b3abae2a |
107 | $try .= "$class\->config()->{lib};"; |
dccbb853 |
108 | $ans = eval $try; |
109 | ok ( $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; |
116 | ok ( $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 | |
ee15d750 |
126 | # all done |
127 | |
128 | ############################################################################### |
129 | # Perl 5.005 does not like ok ($x,undef) |
130 | |
131 | sub 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 |
141 | 1:0 |
142 | 0:1 |
143 | &is_one |
144 | 1:1 |
145 | 0:0 |
146 | &is_positive |
147 | 1:1 |
148 | -1:0 |
149 | &is_negative |
150 | 1:0 |
151 | -1:1 |
152 | &is_nan |
153 | abc:1 |
154 | 1:0 |
155 | &is_inf |
156 | inf:1 |
157 | 0:0 |
158 | &bstr |
159 | 5:5 |
160 | 10:10 |
56d9de68 |
161 | -10:-10 |
ee15d750 |
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 |
56d9de68 |
170 | -5:-5e+0 |
171 | -100:-1e+2 |
172 | abc:NaN |
173 | '+inf':inf |
ee15d750 |
174 | &babs |
175 | -1:1 |
176 | 1:1 |
177 | &bnot |
178 | -2:1 |
179 | 1:-2 |
dccbb853 |
180 | &bzero |
181 | :0 |
182 | &bnan |
183 | :NaN |
184 | abc:NaN |
185 | &bone |
186 | :1 |
187 | '+':1 |
188 | '-':-1 |
189 | &binf |
190 | :inf |
191 | '+':inf |
192 | '-':-inf |