ext/XS/APItest/t/printf.t

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