1#!/usr/bin/perl -w
2# Tests for Number::WithError
3use strict;
4use lib ();
5use File::Spec::Functions ':ALL';
6BEGIN {
7	$| = 1;
8	unless ( $ENV{HARNESS_ACTIVE} ) {
9		require FindBin;
10		$FindBin::Bin = $FindBin::Bin; # Avoid a warning
11		chdir catdir( $FindBin::Bin, updir() );
12		lib->import(
13			catdir('blib', 'lib'),
14			'lib',
15			);
16	}
17}
18
19use Test::More tests => 612;
20
21
22#####################################################################
23
24use Number::WithError qw/:all/;
25
26my @test_args = (
27	{
28		name => 'integer',
29		args => [qw(5)],
30		obj  => { num => '5', errors => [] },
31	},
32	{
33		name => 'decimal',
34		args => [qw(0.1)],
35		obj  => { num => '0.1', errors => [] },
36	},
37	{
38		name => 'scientific',
39		args => [qw(0.001e-15)],
40		obj  => { num => '0.001e-15', errors => [] },
41	},
42	{
43		name => 'scientific with error',
44		args => [qw(155e2 12)],
45		obj  => { num => '155e2', errors => [12] },
46	},
47	{
48		name => 'integer with 3 errors',
49		args => [qw(5 0 3 1.2)],
50		obj  => { num => '5', errors => [0, 3, 1.2] },
51	},
52	{
53		name => 'decimal with 4 errors',
54		args => [qw(0.1 0.1 0.1 0.1 0.1)],
55		obj  => { num => '0.1', errors => [0.1, 0.1, 0.1, 0.1] },
56	},
57	{
58		name => 'scientific with 3 errors incl unbalanced',
59		args => [qw(3.4e5 2), [0.3, 0.5], 2],
60		obj  => { num => '3.4e5', errors => [2, [0.3,0.5], 2] },
61	},
62	{
63		name => 'decimal with undef error and 1 error',
64		args => [qw(.4), undef, 0.1],
65		obj  => { num => '0.4', errors => [undef, 0.1] },
66	},
67	{
68		name => 'string with 1 error',
69		args => ['2.0e-3 +/- 0.1e-3'],
70		obj  => { num => '2.0e-3', errors => [0.1e-3] },
71	},
72	{
73		name => 'string with 1 error (2)',
74		args => ['2.0e-3+/-0.1e-3'],
75		obj  => { num => '2.0e-3', errors => [0.1e-3] },
76	},
77	{
78		name => 'string with 1 error (3)',
79		args => ['2.0e-3+ /-0.1e-3'],
80		obj  => { num => '2.0e-3', errors => [0.1e-3] },
81	},
82	{
83		name => 'string with 1 error (4)',
84		args => ['2.0e-3+/- 0.1e-3'],
85		obj  => { num => '2.0e-3', errors => [0.1e-3] },
86	},
87	{
88		name => 'string with 2 errors',
89		args => ['2.0e-3 +/-0.1e-3+/--0.3e+1'],
90		obj  => { num => '2.0e-3', errors => [0.1e-3, 0.3e+1] },
91	},
92	{
93		name => 'string with 2 errors incl unbalanced',
94		args => ['2.0e-3 +/- 0.1e-3 +0.15e-3 -0.01e-3'],
95		obj  => { num => '2.0e-3', errors => [0.1e-3, [0.15e-3, 0.01e-3]]},
96	},
97	{
98		name => 'string with 2 errors incl unbalanced (2)',
99		args => ['2.0e-3 +/- 0.1e-3 -0.15e-3+0.01e-3'],
100		obj  => { num => '2.0e-3', errors => [0.1e-3, [0.01e-3, 0.15e-3]]},
101	},
102	{
103		name => 'string with 2 errors incl unbalanced (3)',
104		args => ['2.0e-3+/-0.1e-3+0.15e-3-0.01e-3'],
105		obj  => { num => '2.0e-3', errors => [0.1e-3, [0.15e-3, 0.01e-3]]},
106	},
107);
108
109# simple cases
110ok( not defined Number::WithError->new() );
111ok( not defined Number::WithError->new(undef) );
112ok( not defined Number::WithError->new_big() );
113ok( not defined Number::WithError->new_big(undef) );
114ok( not defined witherror() );
115ok( not defined witherror(undef) );
116ok( not defined witherror_big() );
117ok( not defined witherror_big(undef) );
118
119sub test_construction_method {
120    my $name = shift;
121    my $is_big = shift;
122    my $constructor = shift;
123    my $cloner = shift;
124    my $test_args = shift;
125
126    foreach (@$test_args) {
127        print "Testing $name with $_->{name}.\n";
128    	my $o = $_->{obj};
129	    my $args = $_->{args};
130    	my $name = $_->{name};
131
132    	my $num = $constructor->(@$args);
133
134	    isa_ok($num, 'Number::WithError');
135	    isa_ok($num->{num}, 'Math::BigFloat') if $is_big;
136    	ok(abs($num->{num}-$o->{num})<1e-24, $name);
137    	ok(@{$num->{errors}} == @{$o->{errors}}, $name. '; number of errors');
138    	foreach (0..$#{$o->{errors}}) {
139	    	my $err = $o->{errors}[$_];
140    		if (ref($err) eq 'ARRAY') {
141			    if ($is_big) {
142			        my $errno = $_;
143                    isa_ok($num->{errors}[$errno][$_], 'Math::BigFloat') for 0..$#{$num->{errors}[$errno]};
144                }
145	    		ok(abs($err->[0]-$num->{errors}[$_][0])<1e-24, $name.'; error '.$_.'-1');
146    			ok(abs($err->[1]-$num->{errors}[$_][1])<1e-24, $name.'; error '.$_.'-2');
147	    	}
148    		else {
149	    		if (not defined $err) {
150		    		ok(not(defined $num->{errors}[$_])||abs($num->{errors}[$_])<1e-24, $name.'; error '.$_);
151    			}
152	    		else {
153				    isa_ok($num->{errors}[$_], 'Math::BigFloat') if $is_big;
154		    		ok(abs($err-$num->{errors}[$_])<1e-24, $name.'; error '.$_);
155    			}
156		    }
157	    }
158    	# test cloning:
159	    my $copy = $cloner->($num);
160    	is($copy, $num, $name . '; cloning');
161	    ok( overload::StrVal($copy) ne overload::StrVal($num), '; ref not equal after cloning');
162    	ok( ''.$copy->{errors} ne ''.$num->{errors}, '; {error} ref not equal after cloning');
163	    foreach (0..$#{$num->{errors}}) {
164		    next if not ref($num->{errors}[$_]) eq 'ARRAY';
165    		ok($num->{errors}[$_] ne $copy->{errors}[$_], $name . "; Error no. $_, reference not equal after cloning");
166	    }
167    }
168
169}
170
171# test new()
172test_construction_method(
173    "->new()",
174    0, # not a big variant
175    sub {Number::WithError->new(@_)},  # const
176    sub {my $self = shift; $self->new(@_)}, # clone
177    \@test_args
178);
179
180# test witherror()
181test_construction_method(
182    "witherror()",
183    0, # not a big variant
184    sub {witherror(@_)},  # const
185    sub {my $self = shift; $self->new(@_);}, # clone
186    \@test_args
187);
188
189# test new_big()
190test_construction_method(
191    "->new_big()",
192    1, # is big
193    sub {Number::WithError->new_big(@_)},  # const
194    sub {my $self = shift; $self->new_big(@_);}, # clone
195    \@test_args
196);
197
198# test witherror_big()
199test_construction_method(
200    "witherror_big()",
201    1, # is big
202    sub {witherror_big(@_)},  # const
203    sub {my $self = shift; $self->new_big(@_);}, # clone
204    \@test_args
205);
206
207
208
209
210
211
2121;
213