Re: [ID 20010815.012] Unfortunate interaction between -0 cmd line arg ...

Message-Id: <200109091741.f89HfsM18534@crypt.compulink.co.uk>

p4raw-id: //depot/perl@12027

diff --git a/Porting/findvars b/Porting/findvars
index 3cdb854..2d3a9a3 100755 (executable)
--- a/Porting/findvars
+++ b/Porting/findvars
@@ -212,7 +212,6 @@ nice_chunk
 nice_chunk_size
 ninterps
 nomemok
-nrs
 nthreads
 nthreads_cond
 numeric_local

diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 7ce3e07..e7ac6c8 100644 (file)
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -182,8 +182,6 @@ typedef IV IV64;
            ENTER;                                      \
            SAVECOPFILE(&PL_compiling);                 \
            SAVECOPLINE(&PL_compiling);                 \
-           save_svref(&PL_rs);                         \
-           sv_setsv(PL_rs, PL_nrs);                    \
            if (!PL_beginav)                            \
                PL_beginav = newAV();                   \
            av_push(PL_beginav, cv);                    \

diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index c008160..b76c0be 100644 (file)
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -174,7 +174,6 @@ threadstart(void *arg)
     SvREFCNT_dec(PL_ofs_sv);
 
     SvREFCNT_dec(PL_rs);
-    SvREFCNT_dec(PL_nrs);
     SvREFCNT_dec(PL_statname);
     SvREFCNT_dec(PL_errors);
     Safefree(PL_screamfirst);

diff --git a/mg.c b/mg.c
index 3de4420..4fc2ffc 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1911,10 +1911,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        PL_multiline = (i != 0);
        break;
     case '/':
-       SvREFCNT_dec(PL_nrs);
-       PL_nrs = newSVsv(sv);
        SvREFCNT_dec(PL_rs);
-       PL_rs = SvREFCNT_inc(PL_nrs);
+       PL_rs = newSVsv(sv);
        break;
     case '\\':
        if (PL_ors_sv)

diff --git a/op.c b/op.c
index bd3c550..1c7eb15 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4957,8 +4957,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            ENTER;
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);
-           save_svref(&PL_rs);
-           sv_setsv(PL_rs, PL_nrs);
 
            if (!PL_beginav)
                PL_beginav = newAV();

diff --git a/perl.c b/perl.c
index 75dec1b..f35a938 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -212,8 +212,7 @@ perl_construct(pTHXx)
 #endif
     }
 
-    PL_nrs = newSVpvn("\n", 1);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+    PL_rs = newSVpvn("\n", 1);
 
     init_stacks();
 
@@ -540,9 +539,6 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_rs);       /* $/ */
     PL_rs = Nullsv;
 
-    SvREFCNT_dec(PL_nrs);      /* $/ helper */
-    PL_nrs = Nullsv;
-
     PL_multiline = 0;          /* $* */
     Safefree(PL_osname);       /* $^O */
     PL_osname = Nullch;
@@ -1431,10 +1427,12 @@ print \"  \\@INC:\\n    @INC\\n\";");
        PL_e_script = Nullsv;
     }
 
-    /* now that script is parsed, we can modify record separator */
-    SvREFCNT_dec(PL_rs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
+/*
+   Not sure that this is still the right place to do this now that we
+   no longer use PL_nrs. HVDS 2001/09/09
+*/
     sv_setsv(get_sv("/", TRUE), PL_rs);
+
     if (PL_do_undump)
        my_unexec();
 
@@ -2151,14 +2149,14 @@ Perl_moreswitches(pTHX_ char *s)
         I32 flags = 0;
        numlen = 4;
        rschar = (U32)grok_oct(s, &numlen, &flags, NULL);
-       SvREFCNT_dec(PL_nrs);
+       SvREFCNT_dec(PL_rs);
        if (rschar & ~((U8)~0))
-           PL_nrs = &PL_sv_undef;
+           PL_rs = &PL_sv_undef;
        else if (!rschar && numlen >= 2)
-           PL_nrs = newSVpvn("", 0);
+           PL_rs = newSVpvn("", 0);
        else {
            char ch = rschar;
-           PL_nrs = newSVpvn(&ch, 1);
+           PL_rs = newSVpvn(&ch, 1);
        }
        return s + numlen;
     }
@@ -2288,11 +2286,11 @@ Perl_moreswitches(pTHX_ char *s)
            s += numlen;
        }
        else {
-           if (RsPARA(PL_nrs)) {
+           if (RsPARA(PL_rs)) {
                PL_ors_sv = newSVpvn("\n\n",2);
            }
            else {
-               PL_ors_sv = newSVsv(PL_nrs);
+               PL_ors_sv = newSVsv(PL_rs);
            }
        }
        return s;

diff --git a/perl.h b/perl.h
index af8e954..85a50a4 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3067,7 +3067,7 @@ enum {            /* pass one of these to get_vtbl */
 #define HINT_FILETEST_ACCESS   0x00400000
 #define HINT_UTF8              0x00800000
 
-/* Various states of an input record separator SV (rs, nrs) */
+/* Various states of the input record separator SV (rs) */
 #define RsSNARF(sv)   (! SvOK(sv))
 #define RsSIMPLE(sv)  (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
 #define RsPARA(sv)    (SvPOK(sv) && ! SvCUR(sv))

diff --git a/pp_ctl.c b/pp_ctl.c
index 37c3561..0b7daa1 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2894,8 +2894,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
     PL_error_count = 0;
     PL_curcop = &PL_compiling;
     PL_curcop->cop_arybase = 0;
-    SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpvn("\n", 1);
     if (saveop && saveop->op_flags & OPf_SPECIAL)
        PL_in_eval |= EVAL_KEEPERR;
     else
@@ -2933,8 +2931,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
            Perl_croak(aTHX_ "%sCompilation failed in regexp",
                       (*msg ? msg : "Unknown error\n"));
        }
-       SvREFCNT_dec(PL_rs);
-       PL_rs = SvREFCNT_inc(PL_nrs);
 #ifdef USE_5005THREADS
        MUTEX_LOCK(&PL_eval_mutex);
        PL_eval_owner = 0;
@@ -2943,8 +2939,6 @@ S_doeval(pTHX_ int gimme, OP** startop)
 #endif /* USE_5005THREADS */
        RETPUSHUNDEF;
     }
-    SvREFCNT_dec(PL_rs);
-    PL_rs = SvREFCNT_inc(PL_nrs);
     CopLINE_set(&PL_compiling, 0);
     if (startop) {
        *startop = PL_eval_root;

diff --git a/sv.c b/sv.c
index 1505a4f..efac746 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5507,13 +5507,19 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     register STDCHAR *bp;
     register I32 cnt;
     I32 i = 0;
+    I32 rspara = 0;
 
     SV_CHECK_THINKFIRST(sv);
     (void)SvUPGRADE(sv, SVt_PV);
 
     SvSCREAM_off(sv);
 
-    if (RsSNARF(PL_rs)) {
+    if (PL_curcop == &PL_compiling) {
+       /* we always read code in line mode */
+       rsptr = "\n";
+       rslen = 1;
+    }
+    else if (RsSNARF(PL_rs)) {
        rsptr = NULL;
        rslen = 0;
     }
@@ -5545,6 +5551,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
     else if (RsPARA(PL_rs)) {
        rsptr = "\n\n";
        rslen = 2;
+       rspara = 1;
     }
     else {
        /* Get $/ i.e. PL_rs into same encoding as stream wants */
@@ -5563,7 +5570,7 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append)
 
     rslast = rslen ? rsptr[rslen - 1] : '\0';
 
-    if (RsPARA(PL_rs)) {               /* have to do this both before and after */
+    if (rspara) {              /* have to do this both before and after */
        do {                    /* to make sure file boundaries work right */
            if (PerlIO_eof(fp))
                return 0;
@@ -5769,7 +5776,7 @@ screamer2:
        }
     }
 
-    if (RsPARA(PL_rs)) {               /* have to do this both before and after */
+    if (rspara) {              /* have to do this both before and after */
         while (i != EOF) {     /* to make sure file boundaries work right */
            i = PerlIO_getc(fp);
            if (i != '\n') {
@@ -10175,7 +10182,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_tainted         = proto_perl->Ttainted;
     PL_curpm           = proto_perl->Tcurpm;   /* XXX No PMOP ref count */
-    PL_nrs             = sv_dup_inc(proto_perl->Tnrs, param);
     PL_rs              = sv_dup_inc(proto_perl->Trs, param);
     PL_last_in_gv      = gv_dup(proto_perl->Tlast_in_gv, param);
     PL_ofs_sv          = sv_dup_inc(proto_perl->Tofs_sv, param);

diff --git a/t/run/kill_perl.t b/t/run/kill_perl.t
index 225208e..9dcd59d 100644 (file)
--- a/t/run/kill_perl.t
+++ b/t/run/kill_perl.t
@@ -802,3 +802,12 @@ undef foo;
 EXPECT
 Can't modify constant item in undef operator at - line 1, near "foo;"
 Execution of - aborted due to compilation errors.
+######## (?{...}) compilation bounces on PL_rs
+-0
+{
+  /(?{ $x })/;
+  # {
+}
+BEGIN { print "ok\n" }
+EXPECT
+ok

diff --git a/thrdvar.h b/thrdvar.h
index 8ebc533..b35e735 100644 (file)
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -81,7 +81,7 @@ PERLVAR(Ttimesbuf,    struct tms)
 /* Fields used by magic variables such as $@, $/ and so on */
 PERLVAR(Ttainted,      bool)           /* using variables controlled by $< */
 PERLVAR(Tcurpm,                PMOP *)         /* what to do \ interps in REs from */
-PERLVAR(Tnrs,          SV *)
+PERLVAR(Tunused_1,     SV *)           /* placeholder: was Tnrs */
 
 /*
 =for apidoc mn|SV*|PL_rs

diff --git a/toke.c b/toke.c
index d526275..331a71b 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -445,8 +445,6 @@ Perl_lex_start(pTHX_ SV *line)
     PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
     PL_bufend = PL_bufptr + SvCUR(PL_linestr);
     PL_last_lop = PL_last_uni = Nullch;
-    SvREFCNT_dec(PL_rs);
-    PL_rs = newSVpvn("\n", 1);
     PL_rsfp = 0;
 }
 

diff --git a/util.c b/util.c
index 0026909..e1bf571 100644 (file)
--- a/util.c
+++ b/util.c
@@ -3052,8 +3052,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
 
     PL_tainted = t->Ttainted;
     PL_curpm = t->Tcurpm;         /* XXX No PMOP ref count */
-    PL_nrs = newSVsv(t->Tnrs);
-    PL_rs = t->Tnrs ? SvREFCNT_inc(PL_nrs) : Nullsv;
+    PL_rs = newSVsv(t->Trs);
     PL_last_in_gv = Nullgv;
     PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv;
     PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv);

diff --git a/wince/perldll.def b/wince/perldll.def
index 64e1fec..41b94cd 100644 (file)
--- a/wince/perldll.def
+++ b/wince/perldll.def
@@ -184,7 +184,6 @@ EXPORTS
        PL_no_usym
        PL_no_wrongref
        PL_nomemok
-       PL_nrs
        PL_ofmt
        PL_oldbufptr
        PL_oldname