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