ext/XS-APItest/t/printf.t

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