xref: /openbsd-src/gnu/usr.bin/perl/ext/XS-APItest/t/printf.t (revision eac174f2741a08d8deb8aae59a7f778ef9b5d770)
1*eac174f2Safresh1use Test::More tests => 13;
243003dfeSmillert
343003dfeSmillertBEGIN { use_ok('XS::APItest') };
443003dfeSmillert
543003dfeSmillert#########################
643003dfeSmillert
743003dfeSmillertmy $ldok = have_long_double();
843003dfeSmillert
943003dfeSmillert# first some IO redirection
1043003dfeSmillertok open(my $oldout, ">&STDOUT"), "saving STDOUT";
1143003dfeSmillertok open(STDOUT, '>', "foo.out"),"redirecting STDOUT";
1243003dfeSmillert
1343003dfeSmillert# Allow for it to be removed
1443003dfeSmillertEND { unlink "foo.out"; };
1543003dfeSmillert
1643003dfeSmillertselect STDOUT; $| = 1; # make unbuffered
1743003dfeSmillert
1843003dfeSmillert# Run the printf tests
1943003dfeSmillertprint_double(5);
2043003dfeSmillertprint_int(3);
2143003dfeSmillertprint_long(4);
2243003dfeSmillertprint_float(4);
2343003dfeSmillertprint_long_double() if $ldok;  # val=7 hardwired
24*eac174f2Safresh1print_long_doubleL() if $ldok;  # val=7 hardwired
2543003dfeSmillert
2643003dfeSmillertprint_flush();
2743003dfeSmillert
2843003dfeSmillert# Now redirect STDOUT and read from the file
2943003dfeSmillertok open(STDOUT, ">&", $oldout), "restore STDOUT";
309f11ffb7Safresh1ok open(my $foo, '<', 'foo.out'), "open foo.out";
3143003dfeSmillert#print "# Test output by reading from file\n";
3243003dfeSmillert# now test the output
3343003dfeSmillertmy @output = map { chomp; $_ } <$foo>;
3443003dfeSmillertclose $foo;
3543003dfeSmillertok @output >= 4, "captured at least four output lines";
3643003dfeSmillert
3743003dfeSmillertis($output[0], "5.000", "print_double");
3843003dfeSmillertis($output[1], "3", "print_int");
3943003dfeSmillertis($output[2], "4", "print_long");
4043003dfeSmillertis($output[3], "4.000", "print_float");
4143003dfeSmillert
4243003dfeSmillertSKIP: {
43*eac174f2Safresh1   skip "No long doubles", 2 unless $ldok;
4443003dfeSmillert   is($output[4], "7.000", "print_long_double");
45*eac174f2Safresh1   is($output[5], "7.000", "print_long_doubleL");
4643003dfeSmillert}
4743003dfeSmillert
4856d68f1eSafresh1{
4956d68f1eSafresh1    # GH #17338
5056d68f1eSafresh1    # This is unlikely to fail here since int and long are the
5156d68f1eSafresh1    # same size on our usual platforms, but it's less likely to
5256d68f1eSafresh1    # be ignored than the warning that's the real diagnostic
5356d68f1eSafresh1    # for this bug.
5456d68f1eSafresh1    my $uv_max = ~0;
5556d68f1eSafresh1    my $iv_max = $uv_max >> 1;
5656d68f1eSafresh1    my $max_out = "iv $iv_max uv $uv_max";
5756d68f1eSafresh1    is(test_MAX_types(), $max_out,
5856d68f1eSafresh1       "check types for IV_MAX and UV_MAX match IVdf/UVuf");
5956d68f1eSafresh1}
60