1use Test::More tests => 13; 2 3BEGIN { use_ok('XS::APItest') }; 4 5######################### 6 7my $ldok = have_long_double(); 8 9# first some IO redirection 10ok open(my $oldout, ">&STDOUT"), "saving STDOUT"; 11ok open(STDOUT, '>', "foo.out"),"redirecting STDOUT"; 12 13# Allow for it to be removed 14END { unlink "foo.out"; }; 15 16select STDOUT; $| = 1; # make unbuffered 17 18# Run the printf tests 19print_double(5); 20print_int(3); 21print_long(4); 22print_float(4); 23print_long_double() if $ldok; # val=7 hardwired 24print_long_doubleL() if $ldok; # val=7 hardwired 25 26print_flush(); 27 28# Now redirect STDOUT and read from the file 29ok open(STDOUT, ">&", $oldout), "restore STDOUT"; 30ok open(my $foo, '<', 'foo.out'), "open foo.out"; 31#print "# Test output by reading from file\n"; 32# now test the output 33my @output = map { chomp; $_ } <$foo>; 34close $foo; 35ok @output >= 4, "captured at least four output lines"; 36 37is($output[0], "5.000", "print_double"); 38is($output[1], "3", "print_int"); 39is($output[2], "4", "print_long"); 40is($output[3], "4.000", "print_float"); 41 42SKIP: { 43 skip "No long doubles", 2 unless $ldok; 44 is($output[4], "7.000", "print_long_double"); 45 is($output[5], "7.000", "print_long_doubleL"); 46} 47 48{ 49 # GH #17338 50 # This is unlikely to fail here since int and long are the 51 # same size on our usual platforms, but it's less likely to 52 # be ignored than the warning that's the real diagnostic 53 # for this bug. 54 my $uv_max = ~0; 55 my $iv_max = $uv_max >> 1; 56 my $max_out = "iv $iv_max uv $uv_max"; 57 is(test_MAX_types(), $max_out, 58 "check types for IV_MAX and UV_MAX match IVdf/UVuf"); 59} 60