t/io/defout.t

   1 #!./perl
   2 #
   3 # tests for default output handle
   4
   5 # DAPM 30/4/10 this area seems to have been undertested. For now, the only
   6 # tests are ensuring things don't crash when PL_defoutgv isn't a GV;
   7 # it probably needs expanding at some point to cover other stuff.
   8
   9 BEGIN {
  10     chdir 't';
  11     @INC = '../lib';
  12     require './test.pl';
  13 }
  14
  15 plan tests => 16;
  16
  17
  18 my $stdout = *STDOUT;
  19 select($stdout);
  20 $stdout = 1; # whoops, PL_defoutgv no longer a GV!
  21 # XXX It is a GV as of 5.13.7. Is this test file needed any more?
  22
  23 # note that in the tests below, the return values aren't as important
  24 # as the fact that they don't crash
  25
  26 ok print(""), 'print';
  27 ok select(), 'select';
  28
  29 $a = 'fooo';
  30 format STDOUT =
  31 @ @<<
  32 "#", $a
  33 .
  34 ok((write())[0], 'write');
  35
  36 ok($^, '$^');
  37 ok($~, '$~');
  38 ok($=, '$=');
  39 ok($-, '$-');
  40 is($%, 0,      '$%');
  41 is($|, 0,      '$|');
  42 $^ = 1; pass '$^ = 1';
  43 $~ = 1; pass '$~ = 1';
  44 $= = 1; pass '$= = 1';
  45 $- = 1; pass '$- = 1';
  46 $% = 1; pass '$% = 1';
  47 $| = 1; pass '$| = 1';
  48
  49 # Switch to STDERR for this test, so we do not lose our test output
  50 my $stderr = *STDERR;
  51 select($stderr);
  52 $stderr = 1;
  53 ok close(), 'close';