| 1 | BEGIN {
|
|---|
| 2 | chdir 't' if -d 't';
|
|---|
| 3 | @INC = '../lib';
|
|---|
| 4 | push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
|
|---|
| 5 | require Config; import Config;
|
|---|
| 6 | if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
|
|---|
| 7 | print "1..0 # Skip: XS::APItest was not built\n";
|
|---|
| 8 | exit 0;
|
|---|
| 9 | }
|
|---|
| 10 | }
|
|---|
| 11 |
|
|---|
| 12 | use Test::More tests => 11;
|
|---|
| 13 |
|
|---|
| 14 | BEGIN { use_ok('XS::APItest') };
|
|---|
| 15 |
|
|---|
| 16 | #########################
|
|---|
| 17 |
|
|---|
| 18 | my $ldok = have_long_double();
|
|---|
| 19 |
|
|---|
| 20 | # first some IO redirection
|
|---|
| 21 | ok open(my $oldout, ">&STDOUT"), "saving STDOUT";
|
|---|
| 22 | ok open(STDOUT, '>', "foo.out"),"redirecting STDOUT";
|
|---|
| 23 |
|
|---|
| 24 | # Allow for it to be removed
|
|---|
| 25 | END { unlink "foo.out"; };
|
|---|
| 26 |
|
|---|
| 27 | select STDOUT; $| = 1; # make unbuffered
|
|---|
| 28 |
|
|---|
| 29 | # Run the printf tests
|
|---|
| 30 | print_double(5);
|
|---|
| 31 | print_int(3);
|
|---|
| 32 | print_long(4);
|
|---|
| 33 | print_float(4);
|
|---|
| 34 | print_long_double() if $ldok; # val=7 hardwired
|
|---|
| 35 |
|
|---|
| 36 | print_flush();
|
|---|
| 37 |
|
|---|
| 38 | # Now redirect STDOUT and read from the file
|
|---|
| 39 | ok open(STDOUT, ">&", $oldout), "restore STDOUT";
|
|---|
| 40 | ok open(my $foo, "<foo.out"), "open foo.out";
|
|---|
| 41 | #print "# Test output by reading from file\n";
|
|---|
| 42 | # now test the output
|
|---|
| 43 | my @output = map { chomp; $_ } <$foo>;
|
|---|
| 44 | close $foo;
|
|---|
| 45 | ok @output >= 4, "captured at least four output lines";
|
|---|
| 46 |
|
|---|
| 47 | is($output[0], "5.000", "print_double");
|
|---|
| 48 | is($output[1], "3", "print_int");
|
|---|
| 49 | is($output[2], "4", "print_long");
|
|---|
| 50 | is($output[3], "4.000", "print_float");
|
|---|
| 51 |
|
|---|
| 52 | SKIP: {
|
|---|
| 53 | skip "No long doubles", 1 unless $ldok;
|
|---|
| 54 | is($output[4], "7.000", "print_long_double");
|
|---|
| 55 | }
|
|---|
| 56 |
|
|---|