Commit | Line | Data |
1ddff52a |
1 | #!/usr/bin/perl -w |
2 | |
3 | use Test; |
4 | use strict; |
5 | |
6 | BEGIN |
7 | { |
8 | $| = 1; |
9 | # to locate the testing files |
10 | my $location = $0; $location =~ s/upgradef.t//i; |
11 | if ($ENV{PERL_CORE}) |
12 | { |
13 | # testing with the core distribution |
14 | @INC = qw(../t/lib); |
15 | } |
16 | unshift @INC, qw(../lib); # to locate the modules |
17 | if (-d 't') |
18 | { |
19 | chdir 't'; |
20 | require File::Spec; |
21 | unshift @INC, File::Spec->catdir(File::Spec->updir, $location); |
22 | } |
23 | else |
24 | { |
25 | unshift @INC, $location; |
26 | } |
27 | print "# INC = @INC\n"; |
28 | |
29 | plan tests => 0 |
30 | + 6; # our own tests |
31 | } |
32 | |
33 | ############################################################################### |
34 | package Math::BigFloat::Test; |
35 | |
36 | use Math::BigFloat; |
37 | require Exporter; |
38 | use vars qw/@ISA/; |
39 | @ISA = qw/Exporter Math::BigFloat/; |
40 | |
41 | use overload; |
42 | |
43 | sub isa |
44 | { |
45 | my ($self,$class) = @_; |
46 | return if $class =~ /^Math::Big(Int|Float)/; # we aren't one of these |
47 | UNIVERSAL::isa($self,$class); |
48 | } |
49 | |
50 | sub bmul |
51 | { |
52 | return __PACKAGE__->new(123); |
53 | } |
54 | |
55 | sub badd |
56 | { |
57 | return __PACKAGE__->new(321); |
58 | } |
59 | |
60 | ############################################################################### |
61 | package main; |
62 | |
63 | # use Math::BigInt upgrade => 'Math::BigFloat'; |
64 | use Math::BigFloat upgrade => 'Math::BigFloat::Test'; |
65 | |
66 | use vars qw ($scale $class $try $x $y $z $f @args $ans $ans1 $ans1_str $setup |
67 | $ECL $CL); |
68 | $class = "Math::BigFloat"; |
69 | $CL = "Math::BigInt::Calc"; |
70 | $ECL = "Math::BigFloat::Test"; |
71 | |
72 | ok (Math::BigFloat->upgrade(),$ECL); |
73 | ok (Math::BigFloat->downgrade()||'',''); |
74 | |
75 | $x = $class->new(123); $y = $ECL->new(123); $z = $x->bmul($y); |
76 | ok (ref($z),$ECL); ok ($z,123); |
77 | |
78 | $x = $class->new(123); $y = $ECL->new(123); $z = $x->badd($y); |
79 | ok (ref($z),$ECL); ok ($z,321); |
80 | |
81 | |
82 | |
83 | # not yet: |
84 | # require 'upgrade.inc'; # all tests here for sharing |