diff options
| -rw-r--r-- | doio.c | 7 | ||||
| -rw-r--r-- | gv.c | 10 | ||||
| -rw-r--r-- | gv.h | 2 | ||||
| -rw-r--r-- | op.c | 17 | ||||
| -rw-r--r-- | perl.c | 38 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | pp_sort.c | 4 | ||||
| -rw-r--r-- | pp_sys.c | 4 | ||||
| -rw-r--r-- | toke.c | 16 | ||||
| -rw-r--r-- | util.c | 2 |
10 files changed, 60 insertions, 44 deletions
@@ -734,7 +734,7 @@ Perl_nextargv(pTHX_ register GV *gv) IO * const io = GvIOp(gv); if (!PL_argvoutgv) - PL_argvoutgv = gv_fetchpvs("ARGVOUT",GV_ADD,SVt_PVIO); + PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) { IoFLAGS(io) &= ~IOf_START; if (PL_inplace) { @@ -767,7 +767,8 @@ Perl_nextargv(pTHX_ register GV *gv) if (PL_inplace) { TAINT_PROPER("inplace open"); if (oldlen == 1 && *PL_oldname == '-') { - setdefout(gv_fetchpvs("STDOUT",GV_ADD,SVt_PVIO)); + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, + SVt_PVIO)); return IoIFP(GvIOp(gv)); } #ifndef FLEXFILENAMES @@ -934,7 +935,7 @@ Perl_nextargv(pTHX_ register GV *gv) SvREFCNT_dec(oldout); return Nullfp; } - setdefout(gv_fetchpvs("STDOUT",GV_ADD,SVt_PVIO)); + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO)); } return Nullfp; } @@ -762,10 +762,17 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, HV *stash = NULL; const I32 no_init = flags & (GV_NOADD_NOINIT | GV_NOINIT); const I32 no_expand = flags & GV_NOEXPAND; - const I32 add = flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND; + const I32 add = + flags & ~SVf_UTF8 & ~GV_NOADD_NOINIT & ~GV_NOEXPAND & ~GV_NOTQUAL; const char *const name_end = nambeg + full_len; const char *const name_em1 = name_end - 1; + if (flags & GV_NOTQUAL) { + /* Caller promised that there is no stash, so we can skip the check. */ + len = full_len; + goto no_stash; + } + if (full_len > 2 && *name == '*' && isALPHA(name[1])) { /* accidental stringify on a GV? */ name++; @@ -827,6 +834,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, /* No stash in name, so see how we can default */ if (!stash) { + no_stash: if (len && isIDFIRST_lazy(name)) { bool global = FALSE; @@ -173,6 +173,8 @@ Return the SV from the GV. #define GV_NOADD_NOINIT 0x20 /* Don't add the symbol if it's not there. Don't init it if it is there but ! PVGV */ #define GV_NOEXPAND 0x40 /* Don't expand SvOK() entries to PVGV */ +#define GV_NOTQUAL 0x80 /* A plain symbol name, not qualified with a + package (so skip checks for :: and ') */ /* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range. @@ -2050,8 +2050,9 @@ OP * Perl_jmaybe(pTHX_ OP *o) { if (o->op_type == OP_LIST) { - OP * const o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD, - SVt_PV))); + OP * const o2 + = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, + SVt_PV))); o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o)); } return o; @@ -3235,7 +3236,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) GV *gv = Nullgv; if (!force_builtin) { - gv = gv_fetchpvs("do", 0, SVt_PVCV); + gv = gv_fetchpvs("do", GV_NOTQUAL, SVt_PVCV); if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "do", FALSE); gv = gvp ? *gvp : Nullgv; @@ -4974,7 +4975,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) GV * const gv = o ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM) - : gv_fetchpvs("STDOUT", GV_ADD, SVt_PVFM); + : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM); #ifdef GV_UNIQUE_CHECK if (GvUNIQUE(gv)) { @@ -5801,7 +5802,7 @@ Perl_ck_glob(pTHX_ OP *o) if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling) append_elem(OP_GLOB, o, newDEFSVOP()); - if (!((gv = gv_fetchpvs("glob", 0, SVt_PVCV)) + if (!((gv = gv_fetchpvs("glob", GV_NOTQUAL, SVt_PVCV)) && GvCVu(gv) && GvIMPORTED_CV(gv))) { gv = gv_fetchpvs("CORE::GLOBAL::glob", 0, SVt_PVCV); @@ -6223,7 +6224,7 @@ Perl_ck_require(pTHX_ OP *o) if (!(o->op_flags & OPf_SPECIAL)) { /* Wasn't written as CORE::require */ /* handle override, if any */ - gv = gv_fetchpvs("require", 0, SVt_PVCV); + gv = gv_fetchpvs("require", GV_NOTQUAL, SVt_PVCV); if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { GV * const * const gvp = (GV**)hv_fetchs(PL_globalstash, "require", FALSE); gv = gvp ? *gvp : Nullgv; @@ -6384,8 +6385,8 @@ S_simplify_sort(pTHX_ OP *o) const char *gvname; if (!(o->op_flags & OPf_STACKED)) return; - GvMULTI_on(gv_fetchpvs("a", GV_ADD, SVt_PV)); - GvMULTI_on(gv_fetchpvs("b", GV_ADD, SVt_PV)); + GvMULTI_on(gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV)); + GvMULTI_on(gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)); kid = kUNOP->op_first; /* get past null */ if (kid->op_type != OP_SCOPE) return; @@ -1371,7 +1371,7 @@ S_procself_val(pTHX_ SV *sv, const char *arg0) STATIC void S_set_caret_X(pTHX) { dVAR; - GV* tmpgv = gv_fetchpvs("\030", GV_ADD, SVt_PV); /* $^X */ + GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */ if (tmpgv) { #ifdef HAS_PROCSELFEXE S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]); @@ -2122,7 +2122,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) (fp = IoOFP(io))) PerlIO_binmode(aTHX_ fp, IoTYPE(io), 0, ":utf8"); if ((PL_unicode & PERL_UNICODE_INOUT_FLAG) && - (sv = GvSV(gv_fetchpvs("\017PEN", GV_ADD, SVt_PV)))) { + (sv = GvSV(gv_fetchpvs("\017PEN", GV_ADD|GV_NOTQUAL, + SVt_PV)))) { U32 in = PL_unicode & PERL_UNICODE_IN_FLAG; U32 out = PL_unicode & PERL_UNICODE_OUT_FLAG; if (in) { @@ -3461,7 +3462,7 @@ S_init_main_stash(pTHX) table, so it's a small saving to use it rather than allocate another 8 bytes. */ PL_curstname = newSVpvs_share("main"); - gv = gv_fetchpvs("main::", GV_ADD, SVt_PVHV); + gv = gv_fetchpvs("main::", GV_ADD|GV_NOTQUAL, SVt_PVHV); /* If we hadn't caused another reference to "main" to be in the shared string table above, then it would be worth reordering these two, because otherwise all we do is delete "main" from it as a consequence @@ -3470,17 +3471,18 @@ S_init_main_stash(pTHX) hv_name_set(PL_defstash, "main", 4, 0); GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); SvREADONLY_on(gv); - PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD, SVt_PVAV))); + PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL, + SVt_PVAV))); SvREFCNT_inc(PL_incgv); /* Don't allow it to be freed */ GvMULTI_on(PL_incgv); - PL_hintgv = gv_fetchpvs("\010", GV_ADD, SVt_PV); /* ^H */ + PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */ GvMULTI_on(PL_hintgv); - PL_defgv = gv_fetchpvs("_", GV_ADD, SVt_PVAV); + PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV); SvREFCNT_inc(PL_defgv); - PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD, SVt_PV)); + PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD|GV_NOTQUAL, SVt_PV)); SvREFCNT_inc(PL_errgv); GvMULTI_on(PL_errgv); - PL_replgv = gv_fetchpvs("\022", GV_ADD, SVt_PV); /* ^R */ + PL_replgv = gv_fetchpvs("\022", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^R */ GvMULTI_on(PL_replgv); (void)Perl_form(aTHX_ "%240s",""); /* Preallocate temp - for immediate signals. */ #ifdef PERL_DONT_CREATE_GVSV @@ -4490,31 +4492,31 @@ S_init_predump_symbols(pTHX) IO *io; sv_setpvn(get_sv("\"", TRUE), " ", 1); - PL_stdingv = gv_fetchpvs("STDIN", GV_ADD, SVt_PVIO); + PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(PL_stdingv); io = GvIOp(PL_stdingv); IoTYPE(io) = IoTYPE_RDONLY; IoIFP(io) = PerlIO_stdin(); - tmpgv = gv_fetchpvs("stdin", GV_ADD, SVt_PV); + tmpgv = gv_fetchpvs("stdin", GV_ADD|GV_NOTQUAL, SVt_PV); GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io); - tmpgv = gv_fetchpvs("STDOUT", GV_ADD, SVt_PVIO); + tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(tmpgv); io = GvIOp(tmpgv); IoTYPE(io) = IoTYPE_WRONLY; IoOFP(io) = IoIFP(io) = PerlIO_stdout(); setdefout(tmpgv); - tmpgv = gv_fetchpvs("stdout", GV_ADD, SVt_PV); + tmpgv = gv_fetchpvs("stdout", GV_ADD|GV_NOTQUAL, SVt_PV); GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io); - PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD, SVt_PVIO); + PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(PL_stderrgv); io = GvIOp(PL_stderrgv); IoTYPE(io) = IoTYPE_WRONLY; IoOFP(io) = IoIFP(io) = PerlIO_stderr(); - tmpgv = gv_fetchpvs("stderr", GV_ADD, SVt_PV); + tmpgv = gv_fetchpvs("stderr", GV_ADD|GV_NOTQUAL, SVt_PV); GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io); @@ -4547,7 +4549,7 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv) sv_setiv(GvSV(gv_fetchpv(argv[0]+1, GV_ADD, SVt_PV)),1); } } - if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD, SVt_PVAV))) { + if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD|GV_NOTQUAL, SVt_PVAV))) { GvMULTI_on(PL_argvgv); (void)gv_AVadd(PL_argvgv); av_clear(GvAVn(PL_argvgv)); @@ -4582,7 +4584,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register init_argv_symbols(argc,argv); - if ((tmpgv = gv_fetchpvs("0", GV_ADD, SVt_PV))) { + if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) { #ifdef MACOS_TRADITIONAL /* $0 is not majick on a Mac */ sv_setpv(GvSV(tmpgv),MacPerl_MPWFileName(PL_origfilename)); @@ -4591,7 +4593,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register magicname("0", "0", 1); #endif } - if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD, SVt_PVHV))) { + if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) { HV *hv; GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); @@ -4640,7 +4642,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register #endif /* !PERL_MICRO */ } TAINT_NOT; - if ((tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV))) { + if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) { SvREADONLY_off(GvSV(tmpgv)); sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid()); SvREADONLY_on(GvSV(tmpgv)); @@ -1078,7 +1078,7 @@ PP(pp_flip) flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); } else { - GV * const gv = gv_fetchpvs(".", GV_ADD, SVt_PV); + GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv)); } @@ -1172,7 +1172,7 @@ PP(pp_flop) flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); } else { - GV * const gv = gv_fetchpvs(".", GV_ADD, SVt_PV); + GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv)); } } @@ -1631,8 +1631,8 @@ PP(pp_sort) SAVESPTR(PL_firstgv); SAVESPTR(PL_secondgv); SAVESPTR(PL_sortstash); - PL_firstgv = gv_fetchpvs("a", GV_ADD, SVt_PV); - PL_secondgv = gv_fetchpvs("b", GV_ADD, SVt_PV); + PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV); + PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV); PL_sortstash = stash; SAVESPTR(GvSV(PL_firstgv)); SAVESPTR(GvSV(PL_secondgv)); @@ -1330,7 +1330,7 @@ PP(pp_leavewrite) topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%s_TOP", GvNAME(gv))); topgv = gv_fetchsv(topname, 0, SVt_PVFM); if ((topgv && GvFORM(topgv)) || - !gv_fetchpvs("top", 0, SVt_PVFM)) + !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM)) IoTOP_NAME(io) = savesvpv(topname); else IoTOP_NAME(io) = savepvs("top"); @@ -3856,7 +3856,7 @@ PP(pp_fork) if (childpid < 0) RETSETUNDEF; if (!childpid) { - GV * const tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV); + GV * const tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV); if (tmpgv) { SvREADONLY_off(GvSV(tmpgv)); sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid()); @@ -2893,8 +2893,8 @@ Perl_yylex(pTHX) * at least, set argv[0] to the basename of the Perl * interpreter. So, having found "#!", we'll set it right. */ - SV * const x - = GvSV(gv_fetchpvs("\030", GV_ADD, SVt_PV)); /* $^X */ + SV * const x = GvSV(gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, + SVt_PV)); /* $^X */ assert(SvPOK(x) || SvGMAGICAL(x)); if (sv_eq(x, CopFILESV(PL_curcop))) { sv_setpvn(x, ipath, ipathend - ipath); @@ -3127,7 +3127,7 @@ Perl_yylex(pTHX) case 'T': ftst = OP_FTTEXT; break; case 'B': ftst = OP_FTBINARY; break; case 'M': case 'A': case 'C': - gv_fetchpvs("\024",GV_ADD, SVt_PV); + gv_fetchpvs("\024", GV_ADD|GV_NOTQUAL, SVt_PV); switch (tmp) { case 'M': ftst = OP_FTMTIME; break; case 'A': ftst = OP_FTATIME; break; @@ -4694,7 +4694,8 @@ Perl_yylex(pTHX) } case KEY_chdir: - (void)gv_fetchpvs("ENV", GV_ADD, SVt_PVHV); /* may use HOME */ + /* may use HOME */ + (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV); UNI(OP_CHDIR); case KEY_close: @@ -5668,10 +5669,11 @@ Perl_yylex(pTHX) char ctl_l[2]; ctl_l[0] = toCTRL('L'); ctl_l[1] = '\0'; - gv_fetchpvn_flags(ctl_l, 1, GV_ADD, SVt_PV); + gv_fetchpvn_flags(ctl_l, 1, GV_ADD|GV_NOTQUAL, SVt_PV); } #else - gv_fetchpvs("\f", GV_ADD, SVt_PV); /* Make sure $^L is defined */ + /* Make sure $^L is defined */ + gv_fetchpvs("\f", GV_ADD|GV_NOTQUAL, SVt_PV); #endif UNI(OP_ENTERWRITE); @@ -10016,7 +10018,7 @@ S_scan_inputsymbol(pTHX_ char *start) Copy("ARGV",d,5,char); /* Check whether readline() is overriden */ - gv_readline = gv_fetchpvs("readline", 0, SVt_PVCV); + gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV); if ((gv_readline && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)) || @@ -2273,7 +2273,7 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) PerlProc__exit(1); } #endif /* defined OS2 */ - if ((tmpgv = gv_fetchpvs("$", GV_ADD, SVt_PV))) { + if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) { SvREADONLY_off(GvSV(tmpgv)); sv_setiv(GvSV(tmpgv), PerlProc_getpid()); SvREADONLY_on(GvSV(tmpgv)); |