xref: /openbsd-src/gnu/usr.bin/perl/t/io/defout.t (revision 204dddbb9c013d7d6710b288e6a205849f2f539a)
1898184e3Ssthen#!./perl
2898184e3Ssthen#
3898184e3Ssthen# tests for default output handle
4898184e3Ssthen
5898184e3Ssthen# DAPM 30/4/10 this area seems to have been undertested. For now, the only
6898184e3Ssthen# tests are ensuring things don't crash when PL_defoutgv isn't a GV;
7898184e3Ssthen# it probably needs expanding at some point to cover other stuff.
8898184e3Ssthen
9898184e3SsthenBEGIN {
10b8851fccSafresh1    chdir 't' if -d 't';
11898184e3Ssthen    require './test.pl';
129f11ffb7Safresh1    set_up_inc('../lib');
13898184e3Ssthen}
14898184e3Ssthen
15b46d8ef2Safresh1$|=0;   # test.pl makes it 1, and that conflicts with the below.
16b46d8ef2Safresh1
17*204dddbbSafresh1plan tests => 22;
18898184e3Ssthen
19898184e3Ssthen
20898184e3Ssthenmy $stdout = *STDOUT;
21898184e3Ssthenselect($stdout);
22898184e3Ssthen$stdout = 1; # whoops, PL_defoutgv no longer a GV!
23898184e3Ssthen# XXX It is a GV as of 5.13.7. Is this test file needed any more?
24898184e3Ssthen
25898184e3Ssthen# note that in the tests below, the return values aren't as important
26898184e3Ssthen# as the fact that they don't crash
27898184e3Ssthen
28898184e3Ssthenok print(""), 'print';
29898184e3Ssthenok select(), 'select';
30898184e3Ssthen
31898184e3Ssthen$a = 'fooo';
32898184e3Ssthenformat STDOUT =
33898184e3Ssthen@ @<<
34898184e3Ssthen"#", $a
35898184e3Ssthen.
36898184e3Ssthenok((write())[0], 'write');
37898184e3Ssthen
38898184e3Ssthenok($^, '$^');
39898184e3Ssthenok($~, '$~');
40898184e3Ssthenok($=, '$=');
41898184e3Ssthenok($-, '$-');
42898184e3Ssthenis($%, 0,      '$%');
43898184e3Ssthenis($|, 0,      '$|');
44898184e3Ssthen$^ = 1; pass '$^ = 1';
45898184e3Ssthen$~ = 1; pass '$~ = 1';
46898184e3Ssthen$= = 1; pass '$= = 1';
47898184e3Ssthen$- = 1; pass '$- = 1';
48898184e3Ssthen$% = 1; pass '$% = 1';
49898184e3Ssthen$| = 1; pass '$| = 1';
50898184e3Ssthen
51*204dddbbSafresh1# test a NULLed GV
52*204dddbbSafresh1my $t = tempfile;
53*204dddbbSafresh1open FOO, ">", $t or die;
54*204dddbbSafresh1select(FOO);
55*204dddbbSafresh1my $io = *FOO{IO};
56*204dddbbSafresh1*FOO = 0;
57*204dddbbSafresh1$^ = 1; pass 'empty GV: $^ = 1';
58*204dddbbSafresh1$~ = 1; pass 'empty GV: $~ = 1';
59*204dddbbSafresh1$= = 1; pass 'empty GV: $= = 1';
60*204dddbbSafresh1$- = 1; pass 'empty GV: $- = 1';
61*204dddbbSafresh1$% = 1; pass 'empty GV: $% = 1';
62*204dddbbSafresh1$| = 1; pass 'empty GV: $| = 1';
63*204dddbbSafresh1close $io;
64*204dddbbSafresh1
65898184e3Ssthen# Switch to STDERR for this test, so we do not lose our test output
66898184e3Ssthenmy $stderr = *STDERR;
67898184e3Ssthenselect($stderr);
68898184e3Ssthen$stderr = 1;
69898184e3Ssthenok close(), 'close';
70