[asperl] fixups to make it build and pass tests under both compilers

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index 532b0a7..4db69c2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -18,6 +18,12 @@
 #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.
@@ -27,13 +33,14 @@
      ? ( 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));
@@ -42,8 +49,9 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        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();
@@ -51,7 +59,7 @@ gv_ename(GV *gv)
     return SvPV(tmpsv,na);
 }
 
-static OP *
+STATIC OP *
 no_fh_allowed(OP *o)
 {
     yyerror(form("Missing comma after first argument to %s function",
@@ -59,21 +67,21 @@ no_fh_allowed(OP *o)
     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)",
@@ -157,7 +165,7 @@ pad_allocmy(char *name)
     return off;
 }
 
-static PADOFFSET
+STATIC PADOFFSET
 pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 {
     dTHR;
@@ -532,6 +540,11 @@ find_threadsv(char *name)
            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); 
        }
@@ -574,7 +587,8 @@ op_free(OP *o)
        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:
@@ -615,7 +629,7 @@ op_free(OP *o)
     Safefree(o);
 }
 
-static void
+STATIC void
 null(OP *o)
 {
     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
@@ -664,7 +678,7 @@ scalarkids(OP *o)
     return o;
 }
 
-static OP *
+STATIC OP *
 scalarboolean(OP *o)
 {
     if (dowarn &&
@@ -1034,7 +1048,7 @@ scalarseq(OP *o)
     return o;
 }
 
-static OP *
+STATIC OP *
 modkids(OP *o, I32 type)
 {
     OP *kid;
@@ -1535,7 +1549,7 @@ block_end(I32 floor, OP *seq)
     return retval;
 }
 
-static OP *
+STATIC OP *
 newDEFSVOP(void)
 {
 #ifdef USE_THREADS
@@ -1669,7 +1683,7 @@ fold_constants(register OP *o)
     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);
@@ -1734,7 +1748,7 @@ gen_constant_list(register OP *o)
     op = curop = LINKLIST(o);
     o->op_next = 0;
     pp_pushmark(ARGS);
-    runops();
+    CALLRUNOPS();
     op = curop;
     pp_anonlist(ARGS);
     tmps_floor = oldtmps_floor;
@@ -2371,7 +2385,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval)
            list(force_list(listval)) );
 }
 
-static I32
+STATIC I32
 list_assignment(register OP *o)
 {
     if (!o)
@@ -2439,7 +2453,6 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
                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++;
@@ -2615,7 +2628,7 @@ newLOGOP(I32 type, I32 flags, OP *first, OP *other)
     return new_logop(type, flags, &first, &other);
 }
 
-static OP *
+STATIC OP *
 new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dTHR;
@@ -3100,7 +3113,7 @@ cv_undef(CV *cv)
 }
 
 #ifdef DEBUG_CLOSURES
-static void
+STATIC void
 cv_dump(cv)
 CV* cv;
 {
@@ -3145,7 +3158,7 @@ CV* cv;
 }
 #endif /* DEBUG_CLOSURES */
 
-static CV *
+STATIC CV *
 cv_clone2(CV *proto, CV *outside)
 {
     dTHR;
@@ -3309,16 +3322,27 @@ cv_ckproto(CV *cv, GV *gv, char *p)
 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 *
+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;
 
-    sv = Nullsv;
-    for (o = CvSTART(cv); o; o = o->op_next) {
+    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)
@@ -3327,7 +3351,7 @@ cv_const_sv(CV *cv)
            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))
@@ -3369,7 +3393,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        else
            sv_setiv((SV*)gv, -1);
        SvREFCNT_dec(compcv);
-       compcv = NULL;
+       cv = compcv = NULL;
        sub_generation++;
        goto noblock;
     }
@@ -3381,6 +3405,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        /* 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);
@@ -3389,8 +3414,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
            /* 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"))) {
@@ -3601,7 +3627,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv)
 }
 
 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);