#include "EXTERN.h"
#include "perl.h"
+#ifdef PERL_OBJECT
+#define CHECKCALL this->*check
+#else
+#define CHECKCALL *check
+#endif
+
/*
* In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
? ( op_free((OP*)o), \
croak("%s trapped by operation mask", op_desc[type]), \
Nullop ) \
- : (*check[type])((OP*)o))
+ : (CHECKCALL[type])((OP*)o))
+static bool scalar_mod_type _((OP *o, I32 type));
+#ifndef PERL_OBJECT
static I32 list_assignment _((OP *o));
static void bad_type _((I32 n, char *t, char *name, OP *kid));
static OP *modkids _((OP *o, I32 type));
static OP *no_fh_allowed _((OP *o));
-static bool scalar_mod_type _((OP *o, I32 type));
static OP *scalarboolean _((OP *o));
static OP *too_few_arguments _((OP *o, char* name));
static OP *too_many_arguments _((OP *o, char* name));
CV* startcv, I32 cx_ix));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+#endif
-static char*
+STATIC char*
gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
return SvPV(tmpsv,na);
}
-static OP *
+STATIC OP *
no_fh_allowed(OP *o)
{
yyerror(form("Missing comma after first argument to %s function",
return o;
}
-static OP *
+STATIC OP *
too_few_arguments(OP *o, char *name)
{
yyerror(form("Not enough arguments for %s", name));
return o;
}
-static OP *
+STATIC OP *
too_many_arguments(OP *o, char *name)
{
yyerror(form("Too many arguments for %s", name));
return o;
}
-static void
+STATIC void
bad_type(I32 n, char *t, char *name, OP *kid)
{
yyerror(form("Type of arg %d to %s must be %s (not %s)",
return off;
}
-static PADOFFSET
+STATIC PADOFFSET
pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
{
dTHR;
sawampersand = TRUE;
SvREADONLY_on(sv);
/* FALL THROUGH */
+
+ /* XXX %! tied to Errno.pm needs to be added here.
+ * See gv_fetchpv(). */
+ /* case '!': */
+
default:
sv_magic(sv, 0, 0, name, 1);
}
break;
#endif /* USE_THREADS */
default:
- if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
+ if (!(o->op_flags & OPf_REF)
+ || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
break;
/* FALL THROUGH */
case OP_GVSV:
Safefree(o);
}
-static void
+STATIC void
null(OP *o)
{
if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
return o;
}
-static OP *
+STATIC OP *
scalarboolean(OP *o)
{
if (dowarn &&
return o;
}
-static OP *
+STATIC OP *
modkids(OP *o, I32 type)
{
OP *kid;
return retval;
}
-static OP *
+STATIC OP *
newDEFSVOP(void)
{
#ifdef USE_THREADS
curop = LINKLIST(o);
o->op_next = 0;
op = curop;
- runops();
+ CALLRUNOPS();
sv = *(stack_sp--);
if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
pad_swipe(o->op_targ);
if (type == OP_RV2GV)
return newGVOP(OP_GV, 0, (GV*)sv);
else {
- if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+ /* try to smush double to int, but don't smush -2.0 to -2 */
+ if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
+ type != OP_NEGATE)
+ {
IV iv = SvIV(sv);
- if ((double)iv == SvNV(sv)) { /* can we smush double to int */
+ if ((double)iv == SvNV(sv)) {
SvREFCNT_dec(sv);
sv = newSViv(iv);
}
op = curop = LINKLIST(o);
o->op_next = 0;
pp_pushmark(ARGS);
- runops();
+ CALLRUNOPS();
op = curop;
pp_anonlist(ARGS);
tmps_floor = oldtmps_floor;
{
PMOP *pm;
LOGOP *rcop;
+ I32 repl_has_vars = 0;
if (o->op_type == OP_TRANS)
return pmtrans(o, expr, repl);
for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
if (opargs[curop->op_type] & OA_DANGEROUS) {
#ifdef USE_THREADS
- if (curop->op_type == OP_THREADSV
- && strchr("&`'123456789+", curop->op_private)) {
- break;
+ if (curop->op_type == OP_THREADSV) {
+ repl_has_vars = 1;
+ if (strchr("&`'123456789+", curop->op_private))
+ break;
}
#else
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
+ repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
curop->op_type == OP_PADANY) {
- /* is okay */
+ repl_has_vars = 1;
}
else
break;
lastop = curop;
}
}
- if (curop == repl) {
+ if (curop == repl
+ && !(repl_has_vars
+ && (!pm->op_pmregexp
+ || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
pm->op_pmflags |= PMf_CONST; /* const for long enough */
pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
prepend_elem(o->op_type, scalar(repl), o);
}
else {
+ if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+ pm->op_pmflags |= PMf_MAYBE_CONST;
+ pm->op_pmpermflags |= PMf_MAYBE_CONST;
+ }
Newz(1101, rcop, 1, LOGOP);
rcop->op_type = OP_SUBSTCONT;
rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
list(force_list(listval)) );
}
-static I32
+STATIC I32
list_assignment(register OP *o)
{
if (!o)
list(force_list(left)) );
o->op_private = 0 | (flags >> 8);
if (!(left->op_private & OPpLVAL_INTRO)) {
- static int generation = 100;
OP *curop;
OP *lastop = o;
generation++;
return new_logop(type, flags, &first, &other);
}
-static OP *
+STATIC OP *
new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
{
dTHR;
case OP_NULL:
if (k2 && k2->op_type == OP_READLINE
&& (k2->op_flags & OPf_STACKED)
- && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
warnop = k2->op_type;
break;
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr->op_flags & OPf_KIDS) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ 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_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
}
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr && (expr->op_flags & OPf_KIDS)) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ 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_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
if (!block)
}
#ifdef DEBUG_CLOSURES
-static void
+STATIC void
cv_dump(cv)
CV* cv;
{
}
#endif /* DEBUG_CLOSURES */
-static CV *
+STATIC CV *
cv_clone2(CV *proto, CV *outside)
{
dTHR;
SV *
cv_const_sv(CV *cv)
{
- OP *o;
- SV *sv;
-
if (!cv || !SvPOK(cv) || SvCUR(cv))
return Nullsv;
+ return op_const_sv(CvSTART(cv), cv);
+}
- sv = Nullsv;
- for (o = CvSTART(cv); o; o = o->op_next) {
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+ SV *sv = Nullsv;
+
+ if(!o)
+ return Nullsv;
+
+ if(o->op_type == OP_LINESEQ && cLISTOPo->op_first)
+ o = cLISTOPo->op_first->op_sibling;
+
+ for (; o; o = o->op_next) {
OPCODE type = o->op_type;
-
+
+ if(sv && o->op_next == o)
+ return sv;
if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
continue;
if (type == OP_LEAVESUB || type == OP_RETURN)
return Nullsv;
if (type == OP_CONST)
sv = cSVOPo->op_sv;
- else if (type == OP_PADSV) {
+ else if (type == OP_PADSV && cv) {
AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
{
dTHR;
char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
- GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
+ GV *gv = gv_fetchpv(name ? name : "__ANON__",
+ GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
- register CV *cv;
+ register CV *cv=0;
I32 ix;
if (o)
if (proto)
SAVEFREEOP(proto);
+ if (SvTYPE(gv) != SVt_PVGV) { /* Prototype now, and had
+ maximum a prototype before. */
+ if (SvTYPE(gv) > SVt_NULL) {
+ if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
+ warn("Runaway prototype");
+ cv_ckproto((CV*)gv, NULL, ps);
+ }
+ if (ps)
+ sv_setpv((SV*)gv, ps);
+ else
+ sv_setiv((SV*)gv, -1);
+ SvREFCNT_dec(compcv);
+ cv = compcv = NULL;
+ sub_generation++;
+ goto noblock;
+ }
+
if (!name || GvCVGEN(gv))
cv = Nullcv;
else if (cv = GvCV(gv)) {
/* already defined (or promised)? */
if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
SV* const_sv;
+ bool const_changed = TRUE;
if (!block) {
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(compcv);
/* ahem, death to those who redefine active sort subs */
if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
croak("Can't redefine active sort subroutine %s", name);
- const_sv = cv_const_sv(cv);
- if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ if(const_sv = cv_const_sv(cv))
+ const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+ if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse"))) {
}
}
if (!block) {
+ noblock:
copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
}
CV *
-newXS(char *name, void (*subaddr) (CV *), char *filename)
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
{
dTHR;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
if (o->op_flags & OPf_REF)
return o;
- if (o->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {