File: TRmpfr_out_str.t

package info (click to toggle)
libmath-mpfr-perl 4.45-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 1,716 kB
  • sloc: perl: 1,508; ansic: 517; makefile: 9
file content (257 lines) | stat: -rwxr-xr-x 6,505 bytes parent folder | download | duplicates (2)
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";
}