From: Stephen McCamant <smcc@mit.edu>
Date: Sat, 27 Jan 2001 19:31:29 +0000 (-0800)
Subject: Re: [PATCH@8545] [ID 20000808.005] OP_REFGEN as an lvalue
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=75ea820e56eb2905cb7fed3312e2bd10c18778d5;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH@8545] [ID 20000808.005] OP_REFGEN as an lvalue
Message-ID: <14963.32943.102669.67625@soda.csua.berkeley.edu>

p4raw-id: //depot/perl@17717
---

diff --git a/op.c b/op.c
index 82fe5b9..75cff4b 100644
--- a/op.c
+++ b/op.c
@@ -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 abb8aba..1ac45c3 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 4b1d6e3..1205a7a 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;