make $1 et al readonly under threads; make C<undef $1> fail like

C<$1 = undef> does

p4raw-id: //depot/perl@2335

diff --git a/op.c b/op.c
index cdc9332..d98cbd9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -570,6 +570,16 @@ find_threadsv(char *name)
        case '`':
        case '\'':
            PL_sawampersand = TRUE;
+           /* FALL THROUGH */
+       case '1':
+       case '2':
+       case '3':
+       case '4':
+       case '5':
+       case '6':
+       case '7':
+       case '8':
+       case '9':
            SvREADONLY_on(sv);
            /* FALL THROUGH */
 

diff --git a/pp.c b/pp.c
index 2686116..07b83db 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -762,8 +762,11 @@ PP(pp_undef)
        RETPUSHUNDEF;
 
     if (SvTHINKFIRST(sv)) {
-       if (SvREADONLY(sv))
-           RETPUSHUNDEF;
+       if (SvREADONLY(sv)) {
+           dTHR;
+           if (PL_curcop != &PL_compiling)
+               croak(PL_no_modify);
+       }
        if (SvROK(sv))
            sv_unref(sv);
     }

diff --git a/t/op/undef.t b/t/op/undef.t
index 8ab2ec4..5b3c7ef 100755 (executable)
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -1,8 +1,6 @@
 #!./perl
 
-# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
-
-print "1..21\n";
+print "1..23\n";
 
 print defined($a) ? "not ok 1\n" : "ok 1\n";
 
@@ -54,3 +52,10 @@ sub foo { print "ok 19\n"; }
 print defined &foo ? "ok 20\n" : "not ok 20\n";
 undef &foo;
 print defined(&foo) ? "not ok 21\n" : "ok 21\n";
+
+eval { undef $1 };
+print $@ =~ /^Modification of a read/ ? "ok 22\n" : "not ok 22\n";
+
+eval { $1 = undef };
+print $@ =~ /^Modification of a read/ ? "ok 23\n" : "not ok 23\n";
+