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
|
BEGIN {
require Config; import Config;
if ($Config{usequadmath}) {
print "1..0 # Skip: usequadmath\n";
exit(0);
}
}
use Test::More tests => 12;
BEGIN { use_ok('XS::APItest') };
#########################
my $ldok = have_long_double();
# first some IO redirection
ok open(my $oldout, ">&STDOUT"), "saving STDOUT";
ok open(STDOUT, '>', "foo.out"),"redirecting STDOUT";
# Allow for it to be removed
END { unlink "foo.out"; };
select STDOUT; $| = 1; # make unbuffered
# Run the printf tests
print_double(5);
print_int(3);
print_long(4);
print_float(4);
print_long_double() if $ldok; # val=7 hardwired
print_flush();
# Now redirect STDOUT and read from the file
ok open(STDOUT, ">&", $oldout), "restore STDOUT";
ok open(my $foo, '<', 'foo.out'), "open foo.out";
#print "# Test output by reading from file\n";
# now test the output
my @output = map { chomp; $_ } <$foo>;
close $foo;
ok @output >= 4, "captured at least four output lines";
is($output[0], "5.000", "print_double");
is($output[1], "3", "print_int");
is($output[2], "4", "print_long");
is($output[3], "4.000", "print_float");
SKIP: {
skip "No long doubles", 1 unless $ldok;
is($output[4], "7.000", "print_long_double");
}
{
# GH #17338
# This is unlikely to fail here since int and long are the
# same size on our usual platforms, but it's less likely to
# be ignored than the warning that's the real diagnostic
# for this bug.
my $uv_max = ~0;
my $iv_max = $uv_max >> 1;
my $max_out = "iv $iv_max uv $uv_max";
is(test_MAX_types(), $max_out,
"check types for IV_MAX and UV_MAX match IVdf/UVuf");
}
|