diff options
| -rw-r--r-- | op.c | 1 | ||||
| -rwxr-xr-x | t/op/chop.t | 13 | ||||
| -rwxr-xr-x | t/op/ref.t | 38 |
3 files changed, 33 insertions, 19 deletions
@@ -1613,7 +1613,6 @@ Perl_mod(pTHX_ OP *o, I32 type) case OP_AASSIGN: case OP_NEXTSTATE: case OP_DBSTATE: - case OP_CHOMP: PL_modcount = RETURN_UNLIMITED_NUMBER; break; case OP_RV2SV: diff --git a/t/op/chop.t b/t/op/chop.t index abb8aba732..1ac45c3cb9 100755 --- a/t/op/chop.t +++ b/t/op/chop.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 47; +plan tests => 51; $_ = 'abc'; $c = do foo(); @@ -172,3 +172,14 @@ foreach (keys %chop) { is ($_, $chop{$key}, "chop hash key"); } } + +# chop and chomp can't be lvalues +eval 'chop($x) = 1;'; +print $@ =~ /Can\'t modify.*chop.*in.*assignment/ ? "ok 48\n" : "not ok 48\n"; +eval 'chomp($x) = 1;'; +print $@ =~ /Can\'t modify.*chom?p.*in.*assignment/ ? "ok 49\n" : "not ok 49\n"; +eval 'chop($x, $y) = (1, 2);'; +print $@ =~ /Can\'t modify.*chop.*in.*assignment/ ? "ok 50\n" : "not ok 50\n"; +eval 'chomp($x, $y) = (1, 2);'; +print $@ =~ /Can\'t modify.*chom?p.*in.*assignment/ ? "ok 51\n" : "not ok 51\n"; + diff --git a/t/op/ref.t b/t/op/ref.t index 4b1d6e37a7..1205a7a824 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); } -print "1..62\n"; +print "1..63\n"; require 'test.pl'; @@ -214,11 +214,15 @@ print @baa == 3 ? "ok 42\n" : "not ok 42\n"; print grep(ref($_), @baa) == 3 ? "ok 43\n" : "not ok 43\n"; print @bzz == 3 ? "ok 44\n" : "not ok 44\n"; +# also, it can't be an lvalue +eval '\\($x, $y) = (1, 2);'; +print $@ =~ /Can\'t modify.*ref.*in.*assignment/ ? "ok 45\n" : "not ok 45\n"; + # test for proper destruction of lexical objects -sub larry::DESTROY { print "# larry\nok 45\n"; } -sub curly::DESTROY { print "# curly\nok 46\n"; } -sub moe::DESTROY { print "# moe\nok 47\n"; } +sub larry::DESTROY { print "# larry\nok 46\n"; } +sub curly::DESTROY { print "# curly\nok 47\n"; } +sub moe::DESTROY { print "# moe\nok 48\n"; } { my ($joe, @curly, %larry); @@ -232,13 +236,13 @@ print "# left block\n"; # another glob test -$foo = "not ok 48"; +$foo = "not ok 49"; { local(*bar) = "foo" } -$bar = "ok 48"; +$bar = "ok 49"; local(*bar) = *bar; print "$bar\n"; -$var = "ok 49"; +$var = "ok 50"; $_ = \$var; print $$_,"\n"; @@ -247,10 +251,10 @@ print $$_,"\n"; { package A; sub new { bless {}, shift } - DESTROY { print "# destroying 'A'\nok 51\n" } + DESTROY { print "# destroying 'A'\nok 52\n" } package _B; sub new { bless {}, shift } - DESTROY { print "# destroying '_B'\nok 50\n"; bless shift, 'A' } + DESTROY { print "# destroying '_B'\nok 51\n"; bless shift, 'A' } package main; my $b = _B->new; } @@ -262,11 +266,11 @@ print $$_,"\n"; local $SIG{'__DIE__'} = sub { my $m = shift; if ($i++ > 4) { - print "# infinite recursion, bailing\nnot ok 52\n"; + print "# infinite recursion, bailing\nnot ok 53\n"; exit 1; } print "# $m"; - if ($m =~ /^Modification of a read-only/) { print "ok 52\n" } + if ($m =~ /^Modification of a read-only/) { print "ok 53\n" } }; package C; sub new { bless {}, shift } @@ -282,7 +286,7 @@ print $$_,"\n"; { my @a; - $a[1] = "ok 53\n"; + $a[1] = "ok 54\n"; print ${\$_} for @a; } @@ -290,9 +294,9 @@ print $$_,"\n"; $a = [1,2,3]; $a = $a->[1]; print "not " unless $a == 2; -print "ok 54\n"; +print "ok 55\n"; -sub x::DESTROY {print "ok ", 54 + shift->[0], "\n"} +sub x::DESTROY {print "ok ", 55 + shift->[0], "\n"} { my $a1 = bless [4],"x"; my $a2 = bless [3],"x"; { my $a3 = bless [2],"x"; @@ -306,9 +310,9 @@ my $result = runperl (switches=>['-l'], prog=> 'print 1; print qq-*$\*-;print 1;'); my $expect = "1\n*\n*\n1\n"; if ($result eq $expect) { - print "ok 59\n"; + print "ok 60\n"; } else { - print "not ok 59\n"; + print "not ok 60\n"; foreach ($expect, $result) { s/\n/\\n/gs; } @@ -317,7 +321,7 @@ if ($result eq $expect) { # test global destruction -my $test = 60; +my $test = 61; my $test1 = $test + 1; my $test2 = $test + 2; |