1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
|
use strict;
use warnings;
use Math::MPFR qw(:mpfr);
my $tests = 8;
# Because of the way I (sisyphus) build this module with MS
# Visual Studio, XSubs that take a filehandle as an argument
# may not work. It therefore suits my purposes to be able to
# avoid calling (and testing) those particular XSubs
$tests = 1 if $ENV{SISYPHUS_SKIP};
print "1..$tests\n";
if($tests == 1) {
warn "\nskipping all tests - \$ENV{SISYPHUS_SKIP} is set\n";
print "ok 1\n";
exit 0;
}
print "# Using Math::MPFR version ", $Math::MPFR::VERSION, "\n";
print "# Using mpfr library version ", MPFR_VERSION_STRING, "\n";
print "# Using gmp library version ", Math::MPFR::gmp_v(), "\n";
Rmpfr_set_default_prec(64);
my($WR1, $WR2, $WR3, $WR4, $WR5, $WR6, $WR7, $WR8);
my($RD1, $RD2, $RD3, $RD4, $RD5, $RD6, $RD7, $RD8);
my($ret, $ok, $mpfr, $count, $prefix, $suffix);
$mpfr = Math::MPFR->new(17);
open($WR1, '>', 'out1.txt') or die "Can't open WR1: $!";
open($WR2, '>', 'out2.txt') or die "Can't open WR2: $!";
open($WR3, '>', 'out3.txt') or die "Can't open WR3: $!";
open($WR4, '>', 'out4.txt') or die "Can't open WR4: $!";
open($WR5, '>', 'out5.txt') or die "Can't open WR5: $!";
open($WR6, '>', 'out6.txt') or die "Can't open WR6: $!";
open($WR7, '>', 'out7.txt') or die "Can't open WR7: $!";
$prefix = "This is the prefix ";
$suffix = " and this is the suffix\n";
# No prefix, no suffix - the five numbers will all be
# strung together on the one line.
for(1..5) {
$ret = TRmpfr_out_str(\*$WR1, 10, 0, $mpfr, GMP_RNDN);
print $WR7 "From the first loop\n";
}
# Prefix, but no suffix - again, the output will be
# strung together on the one line.
for(1..5) {
$ret = TRmpfr_out_str($prefix, \*$WR2, 10, 0, $mpfr, GMP_RNDN);
print $WR7 "From the second loop";
}
# Suffix, but no prefix - this file will contain 5 lines.
for(1..5) {
$ret = TRmpfr_out_str(\*$WR3, 10, 0, $mpfr, GMP_RNDN, $suffix);
print $WR7 "\nFrom the third loop";
}
print $WR7 "\n";
# Both prefix and suffix - this file will contain 5 lines.
for(1..5) {
$ret = TRmpfr_out_str($prefix, \*$WR4, 10, 0, $mpfr, GMP_RNDN, $suffix);
print $WR7 "From the fourth loop\n";
}
$prefix .= "\n";
# Prefix, but no suffix - this file will contain 6 lines.
for(1..5) {
$ret = TRmpfr_out_str($prefix, \*$WR5, 10, 0, $mpfr, GMP_RNDN);
print $WR7 "From the fifth loop";
}
# Both prefix and suffix - this file will contain 10 lines -
# the prefix appearing on one line, the number and the suffix
# appearing on the next.
for(1..5) {
$ret = TRmpfr_out_str($prefix, \*$WR6, 10, 0, $mpfr, GMP_RNDN, $suffix);
print $WR7 "From the sixth loop";
}
close $WR1 or die "Can't close WR1: $!";
close $WR2 or die "Can't close WR2: $!";
close $WR3 or die "Can't close WR3: $!";
close $WR4 or die "Can't close WR4: $!";
close $WR5 or die "Can't close WR5: $!";
close $WR6 or die "Can't close WR6: $!";
close $WR7 or die "Can't close WR7: $!";
open($RD1, '<', 'out1.txt') or die "Can't open RD1: $!";
open($RD2, '<', 'out2.txt') or die "Can't open RD2: $!";
open($RD3, '<', 'out3.txt') or die "Can't open RD3: $!";
open($RD4, '<', 'out4.txt') or die "Can't open RD4: $!";
open($RD5, '<', 'out5.txt') or die "Can't open RD5: $!";
open($RD6, '<', 'out6.txt') or die "Can't open RD6: $!";
open($RD7, '<', 'out7.txt') or die "Can't open RD7: $!";
$ok = 1;
$count = 0;
while(<$RD1>) {
$count = $.;
chomp;
unless($_ eq '1.70000000000000000000e1'x5) {$ok = 0}
}
if($ok && $count == 1) {print "ok 1\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 1\n";
}
$ok = 1;
$count = 0;
while(<$RD2>) {
$count = $.;
chomp;
unless($_ eq 'This is the prefix 1.70000000000000000000e1'x5) {$ok = 0}
}
if($ok && $count == 1) {print "ok 2\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 2\n";
}
$ok = 1;
$count = 0;
while(<$RD3>) {
$count = $.;
chomp;
unless($_ eq '1.70000000000000000000e1 and this is the suffix') {$ok = 0}
}
if($ok && $count == 5) {print "ok 3\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 3\n";
}
$ok = 1;
$count = 0;
while(<$RD4>) {
$count = $.;
chomp;
unless($_ eq 'This is the prefix 1.70000000000000000000e1 and this is the suffix') {$ok = 0}
}
if($ok && $count == 5) {print "ok 4\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 4\n";
}
$ok = 1;
$count = 0;
while(<$RD5>) {
$count = $.;
chomp;
if($. == 1) {
unless($_ eq 'This is the prefix ') {$ok = 0}
}
elsif($. == 6) {
unless($_ eq '1.70000000000000000000e1') {$ok = 0}
}
else {
unless($_ eq '1.70000000000000000000e1This is the prefix ') {$ok = 0}
}
}
if($ok && $count == 6) {print "ok 5\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 5\n";
}
$ok = 1;
$count = 0;
while(<$RD6>) {
$count = $.;
chomp;
if($. & 1) {
unless($_ eq 'This is the prefix ') {$ok = 0}
}
else {
unless($_ eq '1.70000000000000000000e1 and this is the suffix') {$ok = 0}
}
}
if($ok && $count == 10) {print "ok 6\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 6\n";
}
$ok = 1;
$count = 0;
while(<$RD7>) {
$count = $.;
chomp;
if($. <= 5 && $. >= 1) {
unless($_ eq 'From the first loop') {$ok = 0}
}
if($. == 6) {
unless($_ eq 'From the second loop' x 5) {$ok = 0}
}
if($. <= 11 && $. >= 7) {
unless($_ eq 'From the third loop') {$ok = 0}
}
if($. <= 16 && $. >= 12) {
unless($_ eq 'From the fourth loop') {$ok = 0}
}
if($. == 17) {
unless($_ eq 'From the fifth loop' x 5 . 'From the sixth loop' x 5) {$ok = 0}
}
}
if($ok && $count == 17) {print "ok 7\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 7\n";
}
close $RD1 or die "Can't close RD1: $!";
close $RD2 or die "Can't close RD2: $!";
close $RD3 or die "Can't close RD3: $!";
close $RD4 or die "Can't close RD4: $!";
close $RD5 or die "Can't close RD5: $!";
close $RD6 or die "Can't close RD6: $!";
close $RD7 or die "Can't close RD7: $!";
open($WR8, '>', 'out1.txt') or die "Can't open WR8: $!";
print $WR8 "1.5e2\n";
close $WR8 or die "Can't close WR8: $!";
open($RD8, '<', 'out1.txt') or die "Can't open RD8: $!";
$ret = TRmpfr_inp_str($mpfr, \*$RD8, 10, GMP_RNDN);
close $RD8 or die "Can't close RD8: $!";
if($ret == 5 && $mpfr == 150) {print "ok 8\n"}
else {
warn "\n\$ok: $ok\n\$count: $count\n";
print "not ok 8\n";
}
|