Commit | Line | Data |
---|---|---|
6853e8af RL |
1 | # -*- mode: perl; -*- |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Test::More tests => 173; | |
7 | ||
8 | my $class; | |
9 | ||
10 | BEGIN { | |
11 | $class = 'Math::BigRat'; | |
12 | use_ok($class); | |
13 | } | |
14 | ||
15 | while (<DATA>) { | |
16 | s/#.*$//; # remove comments | |
17 | s/\s+$//; # remove trailing whitespace | |
18 | next unless length; # skip empty lines | |
19 | ||
20 | my ($xval, $yval, $zval) = split /:/; | |
21 | my ($x, $y, $got, @got); | |
22 | ||
23 | for my $context_is_scalar (0, 1) { | |
24 | for my $y_is_scalar (0, 1) { | |
25 | ||
26 | my $test = qq|\$x = $class -> new("$xval");|; | |
27 | ||
28 | $test .= $y_is_scalar | |
29 | ? qq| \$y = "$yval";| | |
30 | : qq| \$y = $class -> new("$yval");|; | |
31 | ||
32 | $test .= $context_is_scalar | |
33 | ? qq| \$got = \$x -> badd(\$y);| | |
34 | : qq| \@got = \$x -> badd(\$y);|; | |
35 | ||
36 | my $desc = "badd() in "; | |
37 | $desc .= $context_is_scalar ? "scalar context" : "list context"; | |
38 | $desc .= $y_is_scalar ? " with y as scalar" : " with y as object"; | |
39 | ||
40 | subtest $desc, | |
41 | sub { | |
42 | plan tests => $context_is_scalar ? 7 : 8; | |
43 | ||
44 | eval $test; | |
45 | is($@, "", "'$test' gives emtpy \$\@"); | |
46 | ||
47 | if ($context_is_scalar) { | |
48 | ||
49 | # Check output. | |
50 | ||
51 | is(ref($got), $class, | |
52 | "'$test' output arg is a $class"); | |
53 | ||
54 | is($got -> bstr(), $zval, | |
55 | "'$test' output arg has the right value"); | |
56 | ||
57 | } else { | |
58 | ||
59 | # Check number of output arguments. | |
60 | ||
61 | cmp_ok(scalar @got, '==', 1, | |
62 | "'$test' gives one output arg"); | |
63 | ||
64 | # Check output. | |
65 | ||
66 | is(ref($got[0]), $class, | |
67 | "'$test' output arg is a $class"); | |
68 | ||
69 | is($got[0] -> bstr(), $zval, | |
70 | "'$test' output arg has the right value"); | |
71 | } | |
72 | ||
73 | # Check the invocand. | |
74 | ||
75 | is(ref($x), $class, | |
76 | "'$test' invocand is still a $class"); | |
77 | ||
78 | is($x -> bstr(), $zval, | |
79 | "'$test' invocand has the right value"); | |
80 | ||
81 | # Check the input argument. | |
82 | ||
83 | if ($y_is_scalar) { | |
84 | ||
85 | is(ref($y), '', | |
86 | "'$test' second input arg is still a scalar"); | |
87 | ||
88 | is($y, $yval, | |
89 | "'$test' second input arg is unmodified"); | |
90 | ||
91 | } else { | |
92 | ||
93 | is(ref($y), $class, | |
94 | "'$test' second input arg is still a $class"); | |
95 | ||
96 | is($y -> bstr(), $yval, | |
97 | "'$test' second input arg is unmodified"); | |
98 | } | |
99 | }; | |
100 | } | |
101 | } | |
102 | } | |
103 | ||
104 | __DATA__ | |
105 | ||
106 | # x and/or y is NaN | |
107 | ||
108 | NaN:NaN:NaN | |
109 | ||
110 | NaN:-inf:NaN | |
111 | NaN:-3:NaN | |
112 | NaN:0:NaN | |
113 | NaN:3:NaN | |
114 | NaN:inf:NaN | |
115 | ||
116 | -inf:NaN:NaN | |
117 | -3:NaN:NaN | |
118 | 0:NaN:NaN | |
119 | 3:NaN:NaN | |
120 | inf:NaN:NaN | |
121 | ||
122 | # x = inf | |
123 | ||
124 | inf:-inf:NaN | |
125 | inf:-3:inf | |
126 | inf:-2:inf | |
127 | inf:-1:inf | |
128 | inf:0:inf | |
129 | inf:1:inf | |
130 | inf:2:inf | |
131 | inf:3:inf | |
132 | inf:inf:inf | |
133 | ||
134 | # x = -inf | |
135 | ||
136 | -inf:-inf:-inf | |
137 | -inf:-3:-inf | |
138 | -inf:-2:-inf | |
139 | -inf:-1:-inf | |
140 | -inf:0:-inf | |
141 | -inf:1:-inf | |
142 | -inf:2:-inf | |
143 | -inf:3:-inf | |
144 | -inf:inf:NaN | |
145 | ||
146 | # y = inf | |
147 | ||
148 | -3:inf:inf | |
149 | -2:inf:inf | |
150 | -1:inf:inf | |
151 | 0:inf:inf | |
152 | 1:inf:inf | |
153 | 2:inf:inf | |
154 | 3:inf:inf | |
155 | ||
156 | # y = -inf | |
157 | ||
158 | -3:-inf:-inf | |
159 | -2:-inf:-inf | |
160 | -1:-inf:-inf | |
161 | 0:-inf:-inf | |
162 | 1:-inf:-inf | |
163 | 2:-inf:-inf | |
164 | 3:-inf:-inf |