1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir 't' if -d 't'; 5*0Sstevel@tonic-gate @INC = '../lib'; 6*0Sstevel@tonic-gate require './test.pl'; 7*0Sstevel@tonic-gate} 8*0Sstevel@tonic-gate 9*0Sstevel@tonic-gate$| = 1; 10*0Sstevel@tonic-gateuse warnings; 11*0Sstevel@tonic-gateuse Config; 12*0Sstevel@tonic-gate$Is_VMS = $^O eq 'VMS'; 13*0Sstevel@tonic-gate$Is_MacOS = $^O eq 'MacOS'; 14*0Sstevel@tonic-gate 15*0Sstevel@tonic-gateplan tests => 107; 16*0Sstevel@tonic-gate 17*0Sstevel@tonic-gatemy $Perl = which_perl(); 18*0Sstevel@tonic-gate 19*0Sstevel@tonic-gate{ 20*0Sstevel@tonic-gate unlink("afile") if -f "afile"; 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate $! = 0; # the -f above will set $! if 'afile' doesn't exist. 23*0Sstevel@tonic-gate ok( open(my $f,"+>afile"), 'open(my $f, "+>...")' ); 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate binmode $f; 26*0Sstevel@tonic-gate ok( -f "afile", ' its a file'); 27*0Sstevel@tonic-gate ok( (print $f "SomeData\n"), ' we can print to it'); 28*0Sstevel@tonic-gate is( tell($f), 9, ' tell()' ); 29*0Sstevel@tonic-gate ok( seek($f,0,0), ' seek set' ); 30*0Sstevel@tonic-gate 31*0Sstevel@tonic-gate $b = <$f>; 32*0Sstevel@tonic-gate is( $b, "SomeData\n", ' readline' ); 33*0Sstevel@tonic-gate ok( -f $f, ' still a file' ); 34*0Sstevel@tonic-gate 35*0Sstevel@tonic-gate eval { die "Message" }; 36*0Sstevel@tonic-gate like( $@, qr/<\$f> line 1/, ' die message correct' ); 37*0Sstevel@tonic-gate 38*0Sstevel@tonic-gate ok( close($f), ' close()' ); 39*0Sstevel@tonic-gate ok( unlink("afile"), ' unlink()' ); 40*0Sstevel@tonic-gate} 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate{ 43*0Sstevel@tonic-gate ok( open(my $f,'>', 'afile'), "open(my \$f, '>', 'afile')" ); 44*0Sstevel@tonic-gate ok( (print $f "a row\n"), ' print'); 45*0Sstevel@tonic-gate ok( close($f), ' close' ); 46*0Sstevel@tonic-gate ok( -s 'afile' < 10, ' -s' ); 47*0Sstevel@tonic-gate} 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gate{ 50*0Sstevel@tonic-gate ok( open(my $f,'>>', 'afile'), "open(my \$f, '>>', 'afile')" ); 51*0Sstevel@tonic-gate ok( (print $f "a row\n"), ' print' ); 52*0Sstevel@tonic-gate ok( close($f), ' close' ); 53*0Sstevel@tonic-gate ok( -s 'afile' > 10, ' -s' ); 54*0Sstevel@tonic-gate} 55*0Sstevel@tonic-gate 56*0Sstevel@tonic-gate{ 57*0Sstevel@tonic-gate ok( open(my $f, '<', 'afile'), "open(my \$f, '<', 'afile')" ); 58*0Sstevel@tonic-gate my @rows = <$f>; 59*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline, list context' ); 60*0Sstevel@tonic-gate is( $rows[0], "a row\n", ' first line read' ); 61*0Sstevel@tonic-gate is( $rows[1], "a row\n", ' second line' ); 62*0Sstevel@tonic-gate ok( close($f), ' close' ); 63*0Sstevel@tonic-gate} 64*0Sstevel@tonic-gate 65*0Sstevel@tonic-gate{ 66*0Sstevel@tonic-gate ok( -s 'afile' < 20, '-s' ); 67*0Sstevel@tonic-gate 68*0Sstevel@tonic-gate ok( open(my $f, '+<', 'afile'), 'open +<' ); 69*0Sstevel@tonic-gate my @rows = <$f>; 70*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline, list context' ); 71*0Sstevel@tonic-gate ok( seek($f, 0, 1), ' seek cur' ); 72*0Sstevel@tonic-gate ok( (print $f "yet another row\n"), ' print' ); 73*0Sstevel@tonic-gate ok( close($f), ' close' ); 74*0Sstevel@tonic-gate ok( -s 'afile' > 20, ' -s' ); 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate unlink("afile"); 77*0Sstevel@tonic-gate} 78*0Sstevel@tonic-gate 79*0Sstevel@tonic-gateSKIP: { 80*0Sstevel@tonic-gate skip "open -| busted and noisy on VMS", 3 if $Is_VMS; 81*0Sstevel@tonic-gate 82*0Sstevel@tonic-gate ok( open(my $f, '-|', <<EOC), 'open -|' ); 83*0Sstevel@tonic-gate $Perl -e "print qq(a row\\n); print qq(another row\\n)" 84*0Sstevel@tonic-gateEOC 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gate my @rows = <$f>; 87*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline, list context' ); 88*0Sstevel@tonic-gate ok( close($f), ' close' ); 89*0Sstevel@tonic-gate} 90*0Sstevel@tonic-gate 91*0Sstevel@tonic-gateSKIP: { 92*0Sstevel@tonic-gate skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; 93*0Sstevel@tonic-gate 94*0Sstevel@tonic-gate ok( open(my $f, '|-', <<EOC), 'open |-' ); 95*0Sstevel@tonic-gate $Perl -pe "s/^not //" 96*0Sstevel@tonic-gateEOC 97*0Sstevel@tonic-gate 98*0Sstevel@tonic-gate my @rows = <$f>; 99*0Sstevel@tonic-gate my $test = curr_test; 100*0Sstevel@tonic-gate print $f "not ok $test - piped in\n"; 101*0Sstevel@tonic-gate next_test; 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate $test = curr_test; 104*0Sstevel@tonic-gate print $f "not ok $test - piped in\n"; 105*0Sstevel@tonic-gate next_test; 106*0Sstevel@tonic-gate ok( close($f), ' close' ); 107*0Sstevel@tonic-gate sleep 1; 108*0Sstevel@tonic-gate pass('flushing'); 109*0Sstevel@tonic-gate} 110*0Sstevel@tonic-gate 111*0Sstevel@tonic-gate 112*0Sstevel@tonic-gateok( !eval { open my $f, '<&', 'afile'; 1; }, '<& on a non-filehandle' ); 113*0Sstevel@tonic-gatelike( $@, qr/Bad filehandle:\s+afile/, ' right error' ); 114*0Sstevel@tonic-gate 115*0Sstevel@tonic-gate 116*0Sstevel@tonic-gate# local $file tests 117*0Sstevel@tonic-gate{ 118*0Sstevel@tonic-gate unlink("afile") if -f "afile"; 119*0Sstevel@tonic-gate 120*0Sstevel@tonic-gate ok( open(local $f,"+>afile"), 'open local $f, "+>", ...' ); 121*0Sstevel@tonic-gate binmode $f; 122*0Sstevel@tonic-gate 123*0Sstevel@tonic-gate ok( -f "afile", ' -f' ); 124*0Sstevel@tonic-gate ok( (print $f "SomeData\n"), ' print' ); 125*0Sstevel@tonic-gate is( tell($f), 9, ' tell' ); 126*0Sstevel@tonic-gate ok( seek($f,0,0), ' seek set' ); 127*0Sstevel@tonic-gate 128*0Sstevel@tonic-gate $b = <$f>; 129*0Sstevel@tonic-gate is( $b, "SomeData\n", ' readline' ); 130*0Sstevel@tonic-gate ok( -f $f, ' still a file' ); 131*0Sstevel@tonic-gate 132*0Sstevel@tonic-gate eval { die "Message" }; 133*0Sstevel@tonic-gate like( $@, qr/<\$f> line 1/, ' proper die message' ); 134*0Sstevel@tonic-gate ok( close($f), ' close' ); 135*0Sstevel@tonic-gate 136*0Sstevel@tonic-gate unlink("afile"); 137*0Sstevel@tonic-gate} 138*0Sstevel@tonic-gate 139*0Sstevel@tonic-gate{ 140*0Sstevel@tonic-gate ok( open(local $f,'>', 'afile'), 'open local $f, ">", ...' ); 141*0Sstevel@tonic-gate ok( (print $f "a row\n"), ' print'); 142*0Sstevel@tonic-gate ok( close($f), ' close'); 143*0Sstevel@tonic-gate ok( -s 'afile' < 10, ' -s' ); 144*0Sstevel@tonic-gate} 145*0Sstevel@tonic-gate 146*0Sstevel@tonic-gate{ 147*0Sstevel@tonic-gate ok( open(local $f,'>>', 'afile'), 'open local $f, ">>", ...' ); 148*0Sstevel@tonic-gate ok( (print $f "a row\n"), ' print'); 149*0Sstevel@tonic-gate ok( close($f), ' close'); 150*0Sstevel@tonic-gate ok( -s 'afile' > 10, ' -s' ); 151*0Sstevel@tonic-gate} 152*0Sstevel@tonic-gate 153*0Sstevel@tonic-gate{ 154*0Sstevel@tonic-gate ok( open(local $f, '<', 'afile'), 'open local $f, "<", ...' ); 155*0Sstevel@tonic-gate my @rows = <$f>; 156*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline list context' ); 157*0Sstevel@tonic-gate ok( close($f), ' close' ); 158*0Sstevel@tonic-gate} 159*0Sstevel@tonic-gate 160*0Sstevel@tonic-gateok( -s 'afile' < 20, ' -s' ); 161*0Sstevel@tonic-gate 162*0Sstevel@tonic-gate{ 163*0Sstevel@tonic-gate ok( open(local $f, '+<', 'afile'), 'open local $f, "+<", ...' ); 164*0Sstevel@tonic-gate my @rows = <$f>; 165*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline list context' ); 166*0Sstevel@tonic-gate ok( seek($f, 0, 1), ' seek cur' ); 167*0Sstevel@tonic-gate ok( (print $f "yet another row\n"), ' print' ); 168*0Sstevel@tonic-gate ok( close($f), ' close' ); 169*0Sstevel@tonic-gate ok( -s 'afile' > 20, ' -s' ); 170*0Sstevel@tonic-gate 171*0Sstevel@tonic-gate unlink("afile"); 172*0Sstevel@tonic-gate} 173*0Sstevel@tonic-gate 174*0Sstevel@tonic-gateSKIP: { 175*0Sstevel@tonic-gate skip "open -| busted and noisy on VMS", 3 if $Is_VMS; 176*0Sstevel@tonic-gate 177*0Sstevel@tonic-gate ok( open(local $f, '-|', <<EOC), 'open local $f, "-|", ...' ); 178*0Sstevel@tonic-gate $Perl -e "print qq(a row\\n); print qq(another row\\n)" 179*0Sstevel@tonic-gateEOC 180*0Sstevel@tonic-gate my @rows = <$f>; 181*0Sstevel@tonic-gate 182*0Sstevel@tonic-gate is( scalar @rows, 2, ' readline list context' ); 183*0Sstevel@tonic-gate ok( close($f), ' close' ); 184*0Sstevel@tonic-gate} 185*0Sstevel@tonic-gate 186*0Sstevel@tonic-gateSKIP: { 187*0Sstevel@tonic-gate skip "Output for |- doesn't go to shell on MacOS", 5 if $Is_MacOS; 188*0Sstevel@tonic-gate 189*0Sstevel@tonic-gate ok( open(local $f, '|-', <<EOC), 'open local $f, "|-", ...' ); 190*0Sstevel@tonic-gate $Perl -pe "s/^not //" 191*0Sstevel@tonic-gateEOC 192*0Sstevel@tonic-gate 193*0Sstevel@tonic-gate my @rows = <$f>; 194*0Sstevel@tonic-gate my $test = curr_test; 195*0Sstevel@tonic-gate print $f "not ok $test - piping\n"; 196*0Sstevel@tonic-gate next_test; 197*0Sstevel@tonic-gate 198*0Sstevel@tonic-gate $test = curr_test; 199*0Sstevel@tonic-gate print $f "not ok $test - piping\n"; 200*0Sstevel@tonic-gate next_test; 201*0Sstevel@tonic-gate ok( close($f), ' close' ); 202*0Sstevel@tonic-gate sleep 1; 203*0Sstevel@tonic-gate pass("Flush"); 204*0Sstevel@tonic-gate} 205*0Sstevel@tonic-gate 206*0Sstevel@tonic-gate 207*0Sstevel@tonic-gateok( !eval { open local $f, '<&', 'afile'; 1 }, 'local <& on non-filehandle'); 208*0Sstevel@tonic-gatelike( $@, qr/Bad filehandle:\s+afile/, ' right error' ); 209*0Sstevel@tonic-gate 210*0Sstevel@tonic-gate{ 211*0Sstevel@tonic-gate local *F; 212*0Sstevel@tonic-gate for (1..2) { 213*0Sstevel@tonic-gate ok( open(F, qq{$Perl -le "print 'ok'"|}), 'open to pipe' ); 214*0Sstevel@tonic-gate is(scalar <F>, "ok\n", ' readline'); 215*0Sstevel@tonic-gate ok( close F, ' close' ); 216*0Sstevel@tonic-gate } 217*0Sstevel@tonic-gate 218*0Sstevel@tonic-gate for (1..2) { 219*0Sstevel@tonic-gate ok( open(F, "-|", qq{$Perl -le "print 'ok'"}), 'open -|'); 220*0Sstevel@tonic-gate is( scalar <F>, "ok\n", ' readline'); 221*0Sstevel@tonic-gate ok( close F, ' close' ); 222*0Sstevel@tonic-gate } 223*0Sstevel@tonic-gate} 224*0Sstevel@tonic-gate 225*0Sstevel@tonic-gate 226*0Sstevel@tonic-gate# other dupping techniques 227*0Sstevel@tonic-gate{ 228*0Sstevel@tonic-gate ok( open(my $stdout, ">&", \*STDOUT), 'dup \*STDOUT into lexical fh'); 229*0Sstevel@tonic-gate ok( open(STDOUT, ">&", $stdout), 'restore dupped STDOUT from lexical fh'); 230*0Sstevel@tonic-gate 231*0Sstevel@tonic-gate { 232*0Sstevel@tonic-gate use strict; # the below should not warn 233*0Sstevel@tonic-gate ok( open(my $stdout, ">&", STDOUT), 'dup STDOUT into lexical fh'); 234*0Sstevel@tonic-gate } 235*0Sstevel@tonic-gate 236*0Sstevel@tonic-gate # used to try to open a file [perl #17830] 237*0Sstevel@tonic-gate ok( open(my $stdin, "<&", fileno STDIN), 'dup fileno(STDIN) into lexical fh'); 238*0Sstevel@tonic-gate} 239*0Sstevel@tonic-gate 240*0Sstevel@tonic-gateSKIP: { 241*0Sstevel@tonic-gate skip "This perl uses perlio", 1 if $Config{useperlio}; 242*0Sstevel@tonic-gate skip "miniperl cannot be relied on to load %Errno" 243*0Sstevel@tonic-gate if $ENV{PERL_CORE_MINITEST}; 244*0Sstevel@tonic-gate # Force the reference to %! to be run time by writing ! as {"!"} 245*0Sstevel@tonic-gate skip "This system doesn't understand EINVAL", 1 246*0Sstevel@tonic-gate unless exists ${"!"}{EINVAL}; 247*0Sstevel@tonic-gate 248*0Sstevel@tonic-gate no warnings 'io'; 249*0Sstevel@tonic-gate ok(!open(F,'>',\my $s) && ${"!"}{EINVAL}, 'open(reference) raises EINVAL'); 250*0Sstevel@tonic-gate} 251*0Sstevel@tonic-gate 252*0Sstevel@tonic-gate{ 253*0Sstevel@tonic-gate ok( !eval { open F, "BAR", "QUUX" }, 'Unknown open() mode' ); 254*0Sstevel@tonic-gate like( $@, qr/\QUnknown open() mode 'BAR'/, ' right error' ); 255*0Sstevel@tonic-gate} 256*0Sstevel@tonic-gate 257*0Sstevel@tonic-gate{ 258*0Sstevel@tonic-gate local $SIG{__WARN__} = sub { $@ = shift }; 259*0Sstevel@tonic-gate 260*0Sstevel@tonic-gate sub gimme { 261*0Sstevel@tonic-gate my $tmphandle = shift; 262*0Sstevel@tonic-gate my $line = scalar <$tmphandle>; 263*0Sstevel@tonic-gate warn "gimme"; 264*0Sstevel@tonic-gate return $line; 265*0Sstevel@tonic-gate } 266*0Sstevel@tonic-gate 267*0Sstevel@tonic-gate open($fh0[0], "TEST"); 268*0Sstevel@tonic-gate gimme($fh0[0]); 269*0Sstevel@tonic-gate like($@, qr/<\$fh0\[...\]> line 1\./, "autoviv fh package aelem"); 270*0Sstevel@tonic-gate 271*0Sstevel@tonic-gate open($fh1{k}, "TEST"); 272*0Sstevel@tonic-gate gimme($fh1{k}); 273*0Sstevel@tonic-gate like($@, qr/<\$fh1{...}> line 1\./, "autoviv fh package helem"); 274*0Sstevel@tonic-gate 275*0Sstevel@tonic-gate my @fh2; 276*0Sstevel@tonic-gate open($fh2[0], "TEST"); 277*0Sstevel@tonic-gate gimme($fh2[0]); 278*0Sstevel@tonic-gate like($@, qr/<\$fh2\[...\]> line 1\./, "autoviv fh lexical aelem"); 279*0Sstevel@tonic-gate 280*0Sstevel@tonic-gate my %fh3; 281*0Sstevel@tonic-gate open($fh3{k}, "TEST"); 282*0Sstevel@tonic-gate gimme($fh3{k}); 283*0Sstevel@tonic-gate like($@, qr/<\$fh3{...}> line 1\./, "autoviv fh lexical helem"); 284*0Sstevel@tonic-gate} 285*0Sstevel@tonic-gate 286*0Sstevel@tonic-gateSKIP: { 287*0Sstevel@tonic-gate skip("These tests use perlio", 5) unless $Config{useperlio}; 288*0Sstevel@tonic-gate my $w; 289*0Sstevel@tonic-gate use warnings 'layer'; 290*0Sstevel@tonic-gate local $SIG{__WARN__} = sub { $w = shift }; 291*0Sstevel@tonic-gate 292*0Sstevel@tonic-gate eval { open(F, ">>>", "afile") }; 293*0Sstevel@tonic-gate like($w, qr/Invalid separator character '>' in PerlIO layer spec/, 294*0Sstevel@tonic-gate "bad open (>>>) warning"); 295*0Sstevel@tonic-gate like($@, qr/Unknown open\(\) mode '>>>'/, 296*0Sstevel@tonic-gate "bad open (>>>) failure"); 297*0Sstevel@tonic-gate 298*0Sstevel@tonic-gate eval { open(F, ">:u", "afile" ) }; 299*0Sstevel@tonic-gate like($w, qr/Unknown PerlIO layer "u"/, 300*0Sstevel@tonic-gate 'bad layer ">:u" warning'); 301*0Sstevel@tonic-gate eval { open(F, "<:u", "afile" ) }; 302*0Sstevel@tonic-gate like($w, qr/Unknown PerlIO layer "u"/, 303*0Sstevel@tonic-gate 'bad layer "<:u" warning'); 304*0Sstevel@tonic-gate eval { open(F, ":c", "afile" ) }; 305*0Sstevel@tonic-gate like($@, qr/Unknown open\(\) mode ':c'/, 306*0Sstevel@tonic-gate 'bad layer ":c" failure'); 307*0Sstevel@tonic-gate} 308*0Sstevel@tonic-gate 309*0Sstevel@tonic-gate# [perl #28986] "open m" crashes Perl 310*0Sstevel@tonic-gate 311*0Sstevel@tonic-gatefresh_perl_like('open m', qr/^Search pattern not terminated at/, 312*0Sstevel@tonic-gate { stderr => 1 }, 'open m test'); 313*0Sstevel@tonic-gate 314*0Sstevel@tonic-gatefresh_perl_is( 315*0Sstevel@tonic-gate 'sub f { open(my $fh, "xxx"); $fh = "f"; } f; f;print "ok"', 316*0Sstevel@tonic-gate 'ok', { stderr => 1 }, 317*0Sstevel@tonic-gate '#29102: Crash on assignment to lexical filehandle'); 318