xref: /openbsd-src/gnu/usr.bin/perl/cpan/Math-BigInt/t/Math/BigInt/Scalar.pm (revision 4c1e55dc91edd6e69ccc60ce855900fbc12cf34f)
1###############################################################################
2# core math lib for BigInt, representing big numbers by normal int/float's
3# for testing only, will fail any bignum test if range is exceeded
4
5package Math::BigInt::Scalar;
6
7use 5.005;
8use strict;
9# use warnings; # dont use warnings for older Perls
10
11require Exporter;
12
13use vars qw/@ISA $VERSION/;
14@ISA = qw(Exporter);
15
16$VERSION = '0.13';
17
18sub api_version() { 1; }
19
20##############################################################################
21# global constants, flags and accessory
22
23# constants for easier life
24my $nan = 'NaN';
25
26##############################################################################
27# create objects from various representations
28
29sub _new
30  {
31  # create scalar ref from string
32  my $d = $_[1];
33  my $x = $d;	# make copy
34  \$x;
35  }
36
37sub _from_hex
38  {
39  # not used
40  }
41
42sub _from_oct
43  {
44  # not used
45  }
46
47sub _from_bin
48  {
49  # not used
50  }
51
52sub _zero
53  {
54  my $x = 0; \$x;
55  }
56
57sub _one
58  {
59  my $x = 1; \$x;
60  }
61
62sub _two
63  {
64  my $x = 2; \$x;
65  }
66
67sub _ten
68  {
69  my $x = 10; \$x;
70  }
71
72sub _copy
73  {
74  my $x = $_[1];
75  my $z = $$x;
76  \$z;
77  }
78
79# catch and throw away
80sub import { }
81
82##############################################################################
83# convert back to string and number
84
85sub _str
86  {
87  # make string
88  "${$_[1]}";
89  }
90
91sub _num
92  {
93  # make a number
94  0+${$_[1]};
95  }
96
97sub _zeros
98  {
99  my $x = $_[1];
100
101  $x =~ /\d(0*)$/;
102  length($1 || '');
103  }
104
105sub _rsft
106  {
107  # not used
108  }
109
110sub _lsft
111  {
112  # not used
113  }
114
115sub _mod
116  {
117  # not used
118  }
119
120sub _gcd
121  {
122  # not used
123  }
124
125sub _sqrt
126  {
127  # not used
128  }
129
130sub _root
131  {
132  # not used
133  }
134
135sub _fac
136  {
137  # not used
138  }
139
140sub _modinv
141  {
142  # not used
143  }
144
145sub _modpow
146  {
147  # not used
148  }
149
150sub _log_int
151  {
152  # not used
153  }
154
155sub _as_hex
156  {
157  sprintf("0x%x",${$_[1]});
158  }
159
160sub _as_bin
161  {
162  sprintf("0b%b",${$_[1]});
163  }
164
165sub _as_oct
166  {
167  sprintf("0%o",${$_[1]});
168  }
169
170##############################################################################
171# actual math code
172
173sub _add
174  {
175  my ($c,$x,$y) = @_;
176  $$x += $$y;
177  return $x;
178  }
179
180sub _sub
181  {
182  my ($c,$x,$y) = @_;
183  $$x -= $$y;
184  return $x;
185  }
186
187sub _mul
188  {
189  my ($c,$x,$y) = @_;
190  $$x *= $$y;
191  return $x;
192  }
193
194sub _div
195  {
196  my ($c,$x,$y) = @_;
197
198  my $u = int($$x / $$y); my $r = $$x % $$y; $$x = $u;
199  return ($x,\$r) if wantarray;
200  return $x;
201  }
202
203sub _pow
204  {
205  my ($c,$x,$y) = @_;
206  my $u = $$x ** $$y; $$x = $u;
207  return $x;
208  }
209
210sub _and
211  {
212  my ($c,$x,$y) = @_;
213  my $u = int($$x) & int($$y); $$x = $u;
214  return $x;
215  }
216
217sub _xor
218  {
219  my ($c,$x,$y) = @_;
220  my $u = int($$x) ^ int($$y); $$x = $u;
221  return $x;
222  }
223
224sub _or
225  {
226  my ($c,$x,$y) = @_;
227  my $u = int($$x) | int($$y); $$x = $u;
228  return $x;
229  }
230
231sub _inc
232  {
233  my ($c,$x) = @_;
234  my $u = int($$x)+1; $$x = $u;
235  return $x;
236  }
237
238sub _dec
239  {
240  my ($c,$x) = @_;
241  my $u = int($$x)-1; $$x = $u;
242  return $x;
243  }
244
245##############################################################################
246# testing
247
248sub _acmp
249  {
250  my ($c,$x, $y) = @_;
251  return ($$x <=> $$y);
252  }
253
254sub _len
255  {
256  return length("${$_[1]}");
257  }
258
259sub _digit
260  {
261  # return the nth digit, negative values count backward
262  # 0 is the rightmost digit
263  my ($c,$x,$n) = @_;
264
265  $n ++;			# 0 => 1, 1 => 2
266  return substr($$x,-$n,1);	# 1 => -1, -2 => 2 etc
267  }
268
269##############################################################################
270# _is_* routines
271
272sub _is_zero
273  {
274  # return true if arg is zero
275  my ($c,$x) = @_;
276  ($$x == 0) <=> 0;
277  }
278
279sub _is_even
280  {
281  # return true if arg is even
282  my ($c,$x) = @_;
283  (!($$x & 1)) <=> 0;
284  }
285
286sub _is_odd
287  {
288  # return true if arg is odd
289  my ($c,$x) = @_;
290  ($$x & 1) <=> 0;
291  }
292
293sub _is_one
294  {
295  # return true if arg is one
296  my ($c,$x) = @_;
297  ($$x == 1) <=> 0;
298  }
299
300sub _is_two
301  {
302  # return true if arg is one
303  my ($c,$x) = @_;
304  ($$x == 2) <=> 0;
305  }
306
307sub _is_ten
308  {
309  # return true if arg is one
310  my ($c,$x) = @_;
311  ($$x == 10) <=> 0;
312  }
313
314###############################################################################
315# check routine to test internal state of corruptions
316
317sub _check
318  {
319  # no checks yet, pull it out from the test suite
320  my ($c,$x) = @_;
321  return "$x is not a reference" if !ref($x);
322  return 0;
323  }
324
3251;
326__END__
327
328=head1 NAME
329
330Math::BigInt::Scalar - Pure Perl module to test Math::BigInt with scalars
331
332=head1 SYNOPSIS
333
334Provides support for big integer calculations via means of 'small' int/floats.
335Only for testing purposes, since it will fail at large values. But it is simple
336enough not to introduce bugs on it's own and to serve as a testbed.
337
338=head1 DESCRIPTION
339
340Please see Math::BigInt::Calc.
341
342=head1 LICENSE
343
344This program is free software; you may redistribute it and/or modify it under
345the same terms as Perl itself.
346
347=head1 AUTHOR
348
349Tels http://bloodgate.com in 2001 - 2007.
350
351=head1 SEE ALSO
352
353L<Math::BigInt>, L<Math::BigInt::Calc>.
354
355=cut
356