/* op.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
static OP *too_many_arguments _((OP *o, char* name));
static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
- CV* startcv, I32 cx_ix, I32 saweval));
+ CV* startcv, I32 cx_ix, I32 saweval, U32 flags));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
static void simplify_sort _((OP *o));
name[1] == '_' && (int)strlen(name) > 2))
{
if (!isPRINT(name[1])) {
- name[3] = '\0';
+ /* 1999-02-27 mjd@plover.com */
+ char *p;
+ p = strchr(name, '\0');
+ /* The next block assumes the buffer is at least 205 chars
+ long. At present, it's always at least 256 chars. */
+ if (p-name > 200) {
+ strcpy(name+200, "...");
+ p = name+199;
+ }
+ else {
+ p[1] = '\0';
+ }
+ /* Move everything else down one character */
+ for (; p-name > 2; p--)
+ *p = *(p-1);
name[2] = toCTRL(name[1]);
name[1] = '^';
}
- croak("Can't use global %s in \"my\"",name);
+ yyerror(form("Can't use global %s in \"my\"",name));
}
if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
SV **svp = AvARRAY(PL_comppad_name);
sv_setpv(sv, name);
if (PL_in_my_stash) {
if (*name != '$')
- croak("Can't declare class for non-scalar %s in \"my\"",name);
+ yyerror(form("Can't declare class for non-scalar %s in \"my\"",
+ name));
SvOBJECT_on(sv);
(void)SvUPGRADE(sv, SVt_PVMG);
SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
return off;
}
+#define FINDLEX_NOSEARCH 1 /* don't search outer contexts */
+
STATIC PADOFFSET
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval)
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval,
+ U32 flags)
{
dTHR;
CV *cv;
}
}
+ if (flags & FINDLEX_NOSEARCH)
+ return 0;
+
/* Nothing in current lexical context--try eval's context, if any.
* This is necessary to let the perldb get at lexically scoped variables.
* XXX This will also probably interact badly with eval tree caching.
default:
if (i == 0 && saweval) {
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval);
+ return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
}
break;
case CXt_EVAL:
continue;
}
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, cv, i-1, saweval);
+ return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
}
}
/* Check if if we're compiling an eval'', and adjust seq to be the
* eval's seq number. This depends on eval'' having a non-null
* CvOUTSIDE() while it is being compiled. The eval'' itself is
- * identified by CvUNIQUE being set and CvGV being null. */
- if (outside && CvUNIQUE(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+ * identified by CvEVAL being true and CvGV being null. */
+ if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
cx = &cxstack[cxstack_ix];
if (CxREALEVAL(cx))
seq = cx->blk_oldcop->cop_seq;
}
/* See if it's in a nested scope */
- off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0);
+ off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
#ifdef USE_THREADS
/* find_threadsv is not reentrant */
PADOFFSET
-find_threadsv(char *name)
+find_threadsv(const char *name)
{
dTHR;
char *p;
/* FALL THROUGH */
case OP_SYSOPEN:
case OP_OPEN:
+ case OP_SELECT: /* XXX c.f. SelectSaver.pm */
case OP_SOCKET:
case OP_OPEN_DIR:
case OP_ACCEPT:
if (repl) {
OP *curop;
- if (pm->op_pmflags & PMf_EVAL)
+ if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
+ if (PL_curcop->cop_line < PL_multi_end)
+ PL_curcop->cop_line = PL_multi_end;
+ }
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
I32 off = pad_findlex(name, ix, SvIVX(namesv),
- CvOUTSIDE(cv), cxstack_ix, 0);
+ CvOUTSIDE(cv), cxstack_ix, 0, 0);
if (!off)
PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
else if (off != ix)
o->op_private |= OPpLOCALE;
#endif
- if (o->op_flags & OPf_STACKED)
+ if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
simplify_sort(o);
if (o->op_flags & OPf_STACKED) { /* may have been cleared */
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
int reversed;
if (!(o->op_flags & OPf_STACKED))
return;
+ GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
+ GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
kid = kUNOP->op_first; /* get past rv2gv */
if (kid->op_type != OP_SCOPE)
return;
bad_type(arg, "block", gv_ename(namegv), o2);
break;
case '*':
+ /* '*' allows any scalar type, including bareword */
proto++;
arg++;
if (o2->op_type == OP_RV2GV)
- goto wrapref;
- {
- OP* kid = o2;
- OP* sib = kid->op_sibling;
- kid->op_sibling = 0;
- o2 = newUNOP(OP_RV2GV, 0, kid);
- o2->op_sibling = sib;
- prev->op_sibling = o2;
- }
- goto wrapref;
+ goto wrapref; /* autoconvert GLOB -> GLOBref */
+ scalar(o2);
+ break;
case '\\':
proto++;
arg++;