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