tweak to show up db-linked-with-libpthread-but-not-perl problem

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

diff --git a/op.c b/op.c
index 1be2428..d796ede 100644 (file)
--- a/op.c
+++ b/op.c
@@ -23,10 +23,17 @@
 /* #define PL_OP_SLAB_ALLOC */
 
 /* XXXXXX testing */
-#define OP_REFCNT_LOCK         NOOP
-#define OP_REFCNT_UNLOCK       NOOP
-#define OpREFCNT_set(o,n)      NOOP
-#define OpREFCNT_dec(o)                ((o)->op_targ--)
+#ifdef USE_ITHREADS
+#  define OP_REFCNT_LOCK               NOOP
+#  define OP_REFCNT_UNLOCK             NOOP
+#  define OpREFCNT_set(o,n)            ((o)->op_targ = (n))
+#  define OpREFCNT_dec(o)              (--(o)->op_targ)
+#else
+#  define OP_REFCNT_LOCK               NOOP
+#  define OP_REFCNT_UNLOCK             NOOP
+#  define OpREFCNT_set(o,n)            NOOP
+#  define OpREFCNT_dec(o)              0
+#endif
 
 #ifdef PL_OP_SLAB_ALLOC 
 #define SLAB_SIZE 8192
@@ -660,7 +667,6 @@ Perl_op_free(pTHX_ OP *o)
                OP_REFCNT_UNLOCK;
                return;
            }
-           o->op_targ = 0;             /* XXXXXX */
            OP_REFCNT_UNLOCK;
            break;
        default:
@@ -4127,9 +4133,9 @@ CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
     CV *cv;
-    MUTEX_LOCK(&PL_cred_mutex);                /* XXX create separate mutex */
+    LOCK_CRED_MUTEX;                   /* XXX create separate mutex */
     cv = cv_clone2(proto, CvOUTSIDE(proto));
-    MUTEX_UNLOCK(&PL_cred_mutex);      /* XXX create separate mutex */
+    UNLOCK_CRED_MUTEX;                 /* XXX create separate mutex */
     return cv;
 }
 
@@ -5286,26 +5292,46 @@ Perl_ck_fun(pTHX_ OP *o)
                    else {
                        I32 flags = OPf_SPECIAL;
                        I32 priv = 0;
+                       PADOFFSET targ = 0;
+
                        /* is this op a FH constructor? */
                        if (is_handle_constructor(o,numargs)) {
-                           flags   = 0;                         
-                           /* Set a flag to tell rv2gv to vivify 
+                           char *name = Nullch;
+                           STRLEN len;
+
+                           flags = 0;
+                           /* Set a flag to tell rv2gv to vivify
                             * need to "prove" flag does not mean something
                             * else already - NI-S 1999/05/07
-                            */ 
-                           priv = OPpDEREF; 
-#if 0
-                           /* Helps with open($array[$n],...) 
-                              but is too simplistic - need to do selectively
-                           */
-                           mod(kid,type);
-#endif
+                            */
+                           priv = OPpDEREF;
+                           if (kid->op_type == OP_PADSV) {
+                               SV **namep = av_fetch(PL_comppad_name,
+                                                     kid->op_targ, 4);
+                               if (namep && *namep)
+                                   name = SvPV(*namep, len);
+                           }
+                           else if (kid->op_type == OP_RV2SV
+                                    && kUNOP->op_first->op_type == OP_GV)
+                           {
+                               GV *gv = cGVOPx_gv(kUNOP->op_first);
+                               name = GvNAME(gv);
+                               len = GvNAMELEN(gv);
+                           }
+                           if (name) {
+                               SV *namesv;
+                               targ = pad_alloc(OP_RV2GV, SVs_PADTMP);
+                               namesv = PL_curpad[targ];
+                               SvUPGRADE(namesv, SVt_PV);
+                               if (*name != '$')
+                                   sv_setpvn(namesv, "$", 1);
+                               sv_catpvn(namesv, name, len);
+                           }
                        }
                        kid->op_sibling = 0;
                        kid = newUNOP(OP_RV2GV, flags, scalar(kid));
-                       if (priv) {
-                           kid->op_private |= priv;
-                       }
+                       kid->op_targ = targ;
+                       kid->op_private |= priv;
                    }
                    kid->op_sibling = sibl;
                    *tokid = kid;
@@ -5350,7 +5376,7 @@ Perl_ck_glob(pTHX_ OP *o)
     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
-#if defined(PERL_INTERNAL_GLOB) && !defined(MINIPERL_BUILD)
+#if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
        OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
@@ -5361,7 +5387,7 @@ Perl_ck_glob(pTHX_ OP *o)
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
        LEAVE;
     }
-#endif /* PERL_INTERNAL_GLOB && !MINIPERL_BUILD */
+#endif /* PERL_EXTERNAL_GLOB */
 
     if (gv && GvIMPORTED_CV(gv)) {
        append_elem(OP_GLOB, o,