From: Hugo van der Sanden Date: Sun, 9 Sep 2001 18:41:54 +0000 (+0100) Subject: Re: [ID 20010815.012] Unfortunate interaction between -0 cmd line arg ... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8bfdd7d95bcb290ba639e2c88c5d4370ab8fcfc0;p=p5sagit%2Fp5-mst-13.2.git Re: [ID 20010815.012] Unfortunate interaction between -0 cmd line arg & (??{CODE}) regex 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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