#include "EXTERN.h"
#define PERL_IN_OP_C
#include "perl.h"
+#include "keywords.h"
/* #define PL_OP_SLAB_ALLOC */
SV *sv;
if (!(
+ PL_in_my == KEY_our ||
isALPHA(name[1]) ||
(PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
- name[1] == '_' && (int)strlen(name) > 2))
+ name[1] == '_' && (int)strlen(name) > 2 ))
{
if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
/* 1999-02-27 mjd@plover.com */
&& strEQ(name, SvPVX(sv)))
{
Perl_warner(aTHX_ WARN_UNSAFE,
- "\"my\" variable %s masks earlier declaration in same %s",
- name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+ "\"%s\" variable %s masks earlier declaration in same %s",
+ (PL_in_my == KEY_our ? "our" : "my"),
+ name,
+ (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
break;
}
}
SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
PL_sv_objcount++;
}
+ if (PL_in_my == KEY_our)
+ SvFLAGS(sv) |= SVpad_OUR;
av_store(PL_comppad_name, off, sv);
SvNVX(sv) = (NV)PAD_MAX;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
SvNVX(namesv) = (NV)PL_curcop->cop_seq;
SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
+ if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */
+ SvFLAGS(namesv) |= SVpad_OUR;
if (SvOBJECT(sv)) { /* A typed var */
SvOBJECT_on(namesv);
(void)SvUPGRADE(namesv, SVt_PVMG);
seq > I_32(SvNVX(sv)))) &&
strEQ(SvPVX(sv), name))
{
- if (SvIVX(sv))
+ if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
return (PADOFFSET)off;
pendoff = off; /* this pending def. will override import */
}
default:
sv_magic(sv, 0, 0, name, 1);
}
- DEBUG_S(PerlIO_printf(PerlIO_stderr(),
+ DEBUG_S(PerlIO_printf(Perl_error_log,
"find_threadsv: new SV %p for $%s%c\n",
sv, (*name < 32) ? "^" : "",
(*name < 32) ? toCTRL(*name) : *name));
my_kid(kid, attrs);
} else if (type == OP_UNDEF) {
return o;
+ } else if (type == OP_RV2SV || /* "our" declaration */
+ type == OP_RV2AV ||
+ type == OP_RV2HV) { /* XXX does this let anything illegal in? */
+ return o;
} else if (type != OP_PADSV &&
type != OP_PADAV &&
type != OP_PADHV &&
o->op_type = OP_SCOPE;
o->op_ppaddr = PL_ppaddr[OP_SCOPE];
kid = ((LISTOP*)o)->op_first;
- if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
- kid->op_type = OP_SETSTATE;
- kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
- }
+ if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+ null(kid);
}
else
o = newLISTOP(OP_SCOPE, 0, o, Nullop);
newSTATEOP(0, Nullch, veop)),
newSTATEOP(0, Nullch, imop) ));
+ PL_hints |= HINT_BLOCK_SCOPE;
PL_copline = NOLINE;
PL_expect = XSTATE;
}
if (k2 && k2->op_type == OP_READLINE
&& (k2->op_flags & OPf_STACKED)
&& ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ {
warnop = k2->op_type;
+ }
break;
case OP_SASSIGN:
if (k1->op_type == OP_READDIR
|| k1->op_type == OP_GLOB
+ || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
|| k1->op_type == OP_EACH)
- warnop = k1->op_type;
+ {
+ warnop = ((k1->op_type == OP_NULL)
+ ? k1->op_targ : k1->op_type);
+ }
break;
}
if (warnop) {
case OP_SASSIGN:
if (k1->op_type == OP_READDIR
|| k1->op_type == OP_GLOB
+ || (k1->op_type == OP_NULL && k1->op_targ == OP_NULL)
|| k1->op_type == OP_EACH)
expr = newUNOP(OP_DEFINED, 0, expr);
break;
case OP_SASSIGN:
if (k1->op_type == OP_READDIR
|| k1->op_type == OP_GLOB
+ || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
|| k1->op_type == OP_EACH)
expr = newUNOP(OP_DEFINED, 0, expr);
break;
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newAVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVAV) ));
-#ifdef IV_IS_QUAD
if (ckWARN(WARN_SYNTAX))
Perl_warner(aTHX_ WARN_SYNTAX,
- "Array @%s missing the @ in argument %" PERL_PRId64 " of %s()",
+ "Array @%s missing the @ in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
-#else
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
- "Array @%s missing the @ in argument %ld of %s()",
- name, (long)numargs, PL_op_desc[type]);
-#endif
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
OP *newop = newHVREF(newGVOP(OP_GV, 0,
gv_fetchpv(name, TRUE, SVt_PVHV) ));
-#ifdef IV_IS_QUAD
if (ckWARN(WARN_SYNTAX))
Perl_warner(aTHX_ WARN_SYNTAX,
- "Hash %%%s missing the %% in argument %" PERL_PRId64 " of %s()",
+ "Hash %%%s missing the %% in argument %"IVdf" of %s()",
name, (IV)numargs, PL_op_desc[type]);
-#else
- if (ckWARN(WARN_SYNTAX))
- Perl_warner(aTHX_ WARN_SYNTAX,
- "Hash %%%s missing the %% in argument %ld of %s()",
- name, (long)numargs, PL_op_desc[type]);
-#endif
op_free(kid);
kid = newop;
kid->op_sibling = sibl;
if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
+#if 1 /*def PERL_INTERNAL_GLOB */
+ /* XXX this can be tightened up and made more failsafe. */
+ if (!gv) {
+ OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
+ modname->op_private |= OPpCONST_BARE;
+ ENTER;
+ utilize(1, start_subparse(FALSE, 0), Nullop, modname,
+ newSVOP(OP_CONST, 0, newSVpvn("globally", 8)));
+ gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
+ LEAVE;
+ }
+#endif /* PERL_INTERNAL_GLOB */
+
if (gv && GvIMPORTED_CV(gv)) {
append_elem(OP_GLOB, o,
newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
key = SvPV(*svp, keylen);
indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
if (!indsvp) {
- Perl_croak(aTHX_ "No such field \"%s\" in variable %s of type %s",
+ Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s",
key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
}
ind = SvIV(*indsvp);
case OP_RV2AV:
case OP_RV2HV:
if (!(o->op_flags & OPf_WANT)
- || o->op_flags & OPf_WANT == OPf_WANT_LIST)
+ || (o->op_flags & OPf_WANT) == OPf_WANT_LIST)
+ {
last_composite = o;
+ }
o->op_seq = PL_op_seqmax++;
break;
projects / p5sagit/p5-mst-13.2.git / blobdiff