1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateBEGIN { 4*0Sstevel@tonic-gate chdir '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-gateplan tests => 13; 10*0Sstevel@tonic-gate 11*0Sstevel@tonic-gateeval { for (\2) { $_ = <FH> } }; 12*0Sstevel@tonic-gatelike($@, 'Modification of a read-only value attempted', '[perl #19566]'); 13*0Sstevel@tonic-gate 14*0Sstevel@tonic-gate{ 15*0Sstevel@tonic-gate open A,"+>a"; $a = 3; 16*0Sstevel@tonic-gate is($a .= <A>, 3, '#21628 - $a .= <A> , A eof'); 17*0Sstevel@tonic-gate close A; $a = 4; 18*0Sstevel@tonic-gate is($a .= <A>, 4, '#21628 - $a .= <A> , A closed'); 19*0Sstevel@tonic-gate unlink "a"; 20*0Sstevel@tonic-gate} 21*0Sstevel@tonic-gate 22*0Sstevel@tonic-gate# 82 is chosen to exceed the length for sv_grow in do_readline (80) 23*0Sstevel@tonic-gateforeach my $k (1, 82) { 24*0Sstevel@tonic-gate my $result 25*0Sstevel@tonic-gate = runperl (stdin => '', stderr => 1, 26*0Sstevel@tonic-gate prog => "\$x = q(k) x $k; \$a{\$x} = qw(v); \$_ = <> foreach keys %a; print qw(end)", 27*0Sstevel@tonic-gate ); 28*0Sstevel@tonic-gate $result =~ s/\n\z// if $^O eq 'VMS'; 29*0Sstevel@tonic-gate is ($result, "end", '[perl #21614] for length ' . length('k' x $k)); 30*0Sstevel@tonic-gate} 31*0Sstevel@tonic-gate 32*0Sstevel@tonic-gate 33*0Sstevel@tonic-gateforeach my $k (1, 21) { 34*0Sstevel@tonic-gate my $result 35*0Sstevel@tonic-gate = runperl (stdin => ' rules', stderr => 1, 36*0Sstevel@tonic-gate prog => "\$x = q(perl) x $k; \$a{\$x} = q(v); foreach (keys %a) {\$_ .= <>; print}", 37*0Sstevel@tonic-gate ); 38*0Sstevel@tonic-gate $result =~ s/\n\z// if $^O eq 'VMS'; 39*0Sstevel@tonic-gate is ($result, ('perl' x $k) . " rules", 'rcatline to shared sv for length ' . length('perl' x $k)); 40*0Sstevel@tonic-gate} 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gate# These COW tests are not going to show up anything on 5.8.x (No Copy On Write) 43*0Sstevel@tonic-gate# but they do no harm, and it makes life easier to keep this file fully in 44*0Sstevel@tonic-gate# sync with 5.9.x 45*0Sstevel@tonic-gate 46*0Sstevel@tonic-gateforeach my $l (1, 82) { 47*0Sstevel@tonic-gate my $k = $l; 48*0Sstevel@tonic-gate $k = 'k' x $k; 49*0Sstevel@tonic-gate my $copy = $k; 50*0Sstevel@tonic-gate $k = <DATA>; 51*0Sstevel@tonic-gate is ($k, "moo\n", 'catline to COW sv for length ' . length $copy); 52*0Sstevel@tonic-gate} 53*0Sstevel@tonic-gate 54*0Sstevel@tonic-gate 55*0Sstevel@tonic-gateforeach my $l (1, 21) { 56*0Sstevel@tonic-gate my $k = $l; 57*0Sstevel@tonic-gate $k = 'perl' x $k; 58*0Sstevel@tonic-gate my $perl = $k; 59*0Sstevel@tonic-gate $k .= <DATA>; 60*0Sstevel@tonic-gate is ($k, "$perl rules\n", 'rcatline to COW sv for length ' . length $perl); 61*0Sstevel@tonic-gate} 62*0Sstevel@tonic-gate 63*0Sstevel@tonic-gateuse strict; 64*0Sstevel@tonic-gateuse File::Spec; 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gateopen F, File::Spec->curdir and sysread F, $_, 1; 67*0Sstevel@tonic-gatemy $err = $! + 0; 68*0Sstevel@tonic-gateclose F; 69*0Sstevel@tonic-gate 70*0Sstevel@tonic-gateSKIP: { 71*0Sstevel@tonic-gate skip "you can read directories as plain files", 2 unless( $err ); 72*0Sstevel@tonic-gate 73*0Sstevel@tonic-gate $!=0; 74*0Sstevel@tonic-gate open F, File::Spec->curdir and $_=<F>; 75*0Sstevel@tonic-gate ok( $!==$err && !defined($_) => 'readline( DIRECTORY )' ); 76*0Sstevel@tonic-gate close F; 77*0Sstevel@tonic-gate 78*0Sstevel@tonic-gate $!=0; 79*0Sstevel@tonic-gate { local $/; 80*0Sstevel@tonic-gate open F, File::Spec->curdir and $_=<F>; 81*0Sstevel@tonic-gate ok( $!==$err && !defined($_) => 'readline( DIRECTORY ) slurp mode' ); 82*0Sstevel@tonic-gate close F; 83*0Sstevel@tonic-gate } 84*0Sstevel@tonic-gate} 85*0Sstevel@tonic-gate 86*0Sstevel@tonic-gate__DATA__ 87*0Sstevel@tonic-gatemoo 88*0Sstevel@tonic-gatemoo 89*0Sstevel@tonic-gate rules 90*0Sstevel@tonic-gate rules 91