perl 5.003_01: lib/ExtUtils/xsubpp
[p5sagit/p5-mst-13.2.git] / gv.c
diff --git a/gv.c b/gv.c
index 3a9b825..c136fc5 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -65,7 +65,7 @@ char *name;
     gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV);
     sv_setpv(GvSV(gv), name);
     if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm")))
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
     if (perldb)
        hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L');
     return gv;
@@ -81,7 +81,7 @@ int multi;
 {
     register GP *gp;
 
-    sv_upgrade(gv, SVt_PVGV);
+    sv_upgrade((SV*)gv, SVt_PVGV);
     if (SvLEN(gv))
        Safefree(SvPVX(gv));
     Newz(602,gp, 1, GP);
@@ -96,7 +96,7 @@ int multi;
     GvNAME(gv) = savepvn(name, len);
     GvNAMELEN(gv) = len;
     if (multi)
-       SvMULTI_on(gv);
+       GvMULTI_on(gv);
 }
 
 static void
@@ -129,6 +129,7 @@ I32 level;
     GV* gv;
     GV** gvp;
     HV* lastchance;
+    CV* cv;
 
     if (!stash)
        return 0;
@@ -142,10 +143,19 @@ I32 level;
     if (SvTYPE(topgv) != SVt_PVGV)
        gv_init(topgv, stash, name, len, TRUE);
 
-    if (GvCV(topgv)) {
-       if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
+    if (cv=GvCV(topgv)) {
+       if (GvCVGEN(topgv) >= sub_generation)
+           return topgv;       /* valid cached inheritance */
+       if (!GvCVGEN(topgv)) {  /* not an inheritance cache */
            return topgv;
+       }
+       else {
+           /* stale cached entry, just junk it */
+           GvCV(topgv) = cv = 0;
+           GvCVGEN(topgv) = 0;
+       }
     }
+    /* if cv is still set, we have to free it if we find something to cache */
 
     gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
     if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
@@ -162,6 +172,11 @@ I32 level;
            }
            gv = gv_fetchmeth(basestash, name, len, level + 1);
            if (gv) {
+               if (cv) {                               /* junk old undef */
+                   assert(SvREFCNT(topgv) > 1);
+                   SvREFCNT_dec(topgv);
+                   SvREFCNT_dec(cv);
+               }
                GvCV(topgv) = GvCV(gv);                 /* cache the CV */
                GvCVGEN(topgv) = sub_generation;        /* valid for now */
                return gv;
@@ -170,8 +185,13 @@ I32 level;
     }
 
     if (!level) {
-       if (lastchance = gv_stashpv("UNIVERSAL", FALSE)) {
+       if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
            if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
+               if (cv) {                               /* junk old undef */
+                   assert(SvREFCNT(topgv) > 1);
+                   SvREFCNT_dec(topgv);
+                   SvREFCNT_dec(cv);
+               }
                GvCV(topgv) = GvCV(gv);                 /* cache the CV */
                GvCVGEN(topgv) = sub_generation;        /* valid for now */
                return gv;
@@ -203,23 +223,69 @@ char* name;
        if (*nsplit == ':')
            --nsplit;
        *nsplit = '\0';
-       stash = gv_stashpv(origname,TRUE);
-       *nsplit = ch;
+       if (strEQ(origname,"SUPER")) {
+           /* Degenerate case ->SUPER::method should really lookup in original stash */
+           SV *tmpstr = sv_2mortal(newSVpv(HvNAME(curcop->cop_stash),0));
+           sv_catpvn(tmpstr, "::SUPER", 7);
+           stash = gv_stashpvn(SvPVX(tmpstr),SvCUR(tmpstr),TRUE);
+           *nsplit = ch;
+           DEBUG_o( deb("Treating %s as %s::%s\n",origname,HvNAME(stash),name) );
+       } else {
+           stash = gv_stashpvn(origname, nsplit - origname, TRUE);
+           *nsplit = ch;
+       }
     }
     gv = gv_fetchmeth(stash, name, nend - name, 0);
+
+    if (!gv) {
+       /* Failed obvious case - look for SUPER as last element of stash's name */
+       char *packname = HvNAME(stash);
+       STRLEN len     = strlen(packname);
+       if ((len -= 7) >= 0 && strEQ(packname+len,"::SUPER")) {
+           /* Now look for @.*::SUPER::ISA */
+           GV** gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
+           if (!gvp || (gv = *gvp) == (GV*)&sv_undef || !GvAV(gv)) {
+               /* No @ISA in package ending in ::SUPER - drop suffix
+                  and see if there is an @ISA there
+                */
+               HV *basestash;
+               char ch = packname[len];
+               AV *av;
+               packname[len] = '\0';
+               basestash = gv_stashpvn(packname, len, TRUE);
+               packname[len] = ch;
+               gvp = (GV**)hv_fetch(basestash,"ISA",3,FALSE);
+               if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
+                    /* Okay found @ISA after dropping the SUPER, alias it */
+                    SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
+                    sv_catpvn(tmpstr, "::ISA", 5);
+                    gv  = gv_fetchpv(SvPV(tmpstr,na),TRUE,SVt_PVGV);
+                     if (gv) {
+                       GvAV(gv) = (AV*)SvREFCNT_inc(av);
+                       /* ... and re-try lookup */
+                       gv = gv_fetchmeth(stash, name, nend - name, 0);
+                    } else {
+                       croak("Cannot create %s::ISA",HvNAME(stash));
+                    }
+               }
+           }
+       }     
+    }
+
     if (!gv) {
        CV* cv;
 
        if (strEQ(name,"import") || strEQ(name,"unimport"))
-           gv = &sv_yes;
+           gv = (GV*)&sv_yes;
        else if (strNE(name, "AUTOLOAD")) {
            gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0);
            if (gv && (cv = GvCV(gv))) { /* One more chance... */
-               SV *tmpstr = sv_newmortal();
-               sv_catpv(tmpstr,HvNAME(stash));
+               SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
                sv_catpvn(tmpstr,"::", 2);
                sv_catpvn(tmpstr, name, nend - name);
                sv_setsv(GvSV(CvGV(cv)), tmpstr);
+               if (tainting)
+                   sv_unmagic(GvSV(CvGV(cv)), 't');
            }
        }
     }
@@ -231,10 +297,31 @@ gv_stashpv(name,create)
 char *name;
 I32 create;
 {
-    char tmpbuf[1234];
+    return gv_stashpvn(name, strlen(name), create);
+}
+
+HV*
+gv_stashpvn(name,namelen,create)
+char *name;
+U32 namelen;
+I32 create;
+{
+    char tmpbuf[1203];
     HV *stash;
     GV *tmpgv;
-    sprintf(tmpbuf,"%.*s::",1200,name);
+
+    if (namelen > 1200) {
+       namelen = 1200;
+#ifdef VMS
+       warn("Weird package name \"%s\" truncated", name);
+#else
+       warn("Weird package name \"%.*s...\" truncated", namelen, name);
+#endif
+    }
+    Copy(name,tmpbuf,namelen,char);
+    tmpbuf[namelen++] = ':';
+    tmpbuf[namelen++] = ':';
+    tmpbuf[namelen] = '\0';
     tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV);
     if (!tmpgv)
        return 0;
@@ -251,7 +338,10 @@ gv_stashsv(sv,create)
 SV *sv;
 I32 create;
 {
-    return gv_stashpv(SvPV(sv,na), create);
+    register char *ptr;
+    STRLEN len;
+    ptr = SvPV(sv,len);
+    return gv_stashpvn(ptr, len, create);
 }
 
 
@@ -270,13 +360,16 @@ I32 sv_type;
     bool global = FALSE;
     char *tmpbuf;
 
+    if (*name == '*' && isALPHA(name[1])) /* accidental stringify on a GV? */
+       name++;
+
     for (namend = name; *namend; namend++) {
        if ((*namend == '\'' && namend[1]) ||
            (*namend == ':' && namend[1] == ':'))
        {
            if (!stash)
                stash = defstash;
-           if (!SvREFCNT(stash))       /* symbol table under destruction */
+           if (!stash || !SvREFCNT(stash)) /* symbol table under destruction */
                return Nullgv;
 
            len = namend - name;
@@ -293,7 +386,7 @@ I32 sv_type;
                gv = *gvp;
 
                if (SvTYPE(gv) == SVt_PVGV)
-                   SvMULTI_on(gv);
+                   GvMULTI_on(gv);
                else if (!add)
                    return Nullgv;
                else
@@ -311,7 +404,7 @@ I32 sv_type;
            namend++;
            name = namend;
            if (!*name)
-               return gv ? gv : *hv_fetch(defstash, "main::", 6, TRUE);
+               return gv ? gv : (GV*)*hv_fetch(defstash, "main::", 6, TRUE);
        }
     }
     len = namend - name;
@@ -350,9 +443,32 @@ I32 sv_type;
                stash = defstash;
            else if ((COP*)curcop == &compiling) {
                stash = curstash;
-               if (add && (hints & HINT_STRICT_VARS) && sv_type != SVt_PVCV) {
-                   if (stash && !hv_fetch(stash,name,len,0))
+               if (add && (hints & HINT_STRICT_VARS) &&
+                   sv_type != SVt_PVCV &&
+                   sv_type != SVt_PVGV &&
+                   sv_type != SVt_PVFM &&
+                   sv_type != SVt_PVIO &&
+                   !(len == 1 && sv_type == SVt_PV && strchr("ab",*name)) )
+               {
+                   gvp = (GV**)hv_fetch(stash,name,len,0);
+                   if (!gvp ||
+                       *gvp == (GV*)&sv_undef ||
+                       SvTYPE(*gvp) != SVt_PVGV)
+                   {
+                       stash = 0;
+                   }
+                   else if (sv_type == SVt_PV   && !GvIMPORTED_SV(*gvp) ||
+                            sv_type == SVt_PVAV && !GvIMPORTED_AV(*gvp) ||
+                            sv_type == SVt_PVHV && !GvIMPORTED_HV(*gvp) )
+                   {
+                       warn("Variable \"%c%s\" is not imported",
+                           sv_type == SVt_PVAV ? '@' :
+                           sv_type == SVt_PVHV ? '%' : '$',
+                           name);
+                       if (GvCV(*gvp))
+                           warn("(Did you mean &%s instead?)\n", name);
                        stash = 0;
+                   }
                }
            }
            else
@@ -383,7 +499,7 @@ I32 sv_type;
     gv = *gvp;
     if (SvTYPE(gv) == SVt_PVGV) {
        if (add) {
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            gv_init_sv(gv, sv_type);
        }
        return gv;
@@ -407,30 +523,30 @@ I32 sv_type;
     case 'a':
     case 'b':
        if (len == 1)
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'E':
        if (strnEQ(name, "EXPORT", 6))
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
        break;
     case 'I':
        if (strEQ(name, "ISA")) {
            AV* av = GvAVn(gv);
-           SvMULTI_on(gv);
+           GvMULTI_on(gv);
            sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0);
            if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1)
            {
                char *pname;
                av_push(av, newSVpv(pname = "NDBM_File",0));
-               gv_stashpv(pname, TRUE);
+               gv_stashpvn(pname, 9, TRUE);
                av_push(av, newSVpv(pname = "DB_File",0));
-               gv_stashpv(pname, TRUE);
+               gv_stashpvn(pname, 7, TRUE);
                av_push(av, newSVpv(pname = "GDBM_File",0));
-               gv_stashpv(pname, TRUE);
+               gv_stashpvn(pname, 9, TRUE);
                av_push(av, newSVpv(pname = "SDBM_File",0));
-               gv_stashpv(pname, TRUE);
+               gv_stashpvn(pname, 9, TRUE);
                av_push(av, newSVpv(pname = "ODBM_File",0));
-               gv_stashpv(pname, TRUE);
+               gv_stashpvn(pname, 9, TRUE);
            }
        }
        break;
@@ -438,7 +554,7 @@ I32 sv_type;
     case 'O':
         if (strEQ(name, "OVERLOAD")) {
             HV* hv = GvHVn(gv);
-            SvMULTI_on(gv);
+            GvMULTI_on(gv);
             sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0);
         }
         break;
@@ -446,11 +562,19 @@ I32 sv_type;
     case 'S':
        if (strEQ(name, "SIG")) {
            HV *hv;
+           I32 i;
            siggv = gv;
-           SvMULTI_on(siggv);
+           GvMULTI_on(siggv);
            hv = GvHVn(siggv);
            hv_magic(hv, siggv, 'S');
-
+           for(i=1;sig_name[i];i++) {
+               SV ** init;
+               init=hv_fetch(hv,sig_name[i],strlen(sig_name[i]),1);
+               if(init)
+                       sv_setsv(*init,&sv_undef);
+               psig_ptr[i] = 0;
+               psig_name[i] = 0;
+           }
            /* initialize signal stack */
            signalstack = newAV();
            AvREAL_off(signalstack);
@@ -508,13 +632,16 @@ I32 sv_type;
     case '\\':
     case '/':
     case '|':
+    case '\001':
     case '\004':
+    case '\005':
+    case '\006':
     case '\010':
+    case '\017':
     case '\t':
     case '\020':
     case '\024':
     case '\027':
-    case '\006':
        if (len > 1)
            break;
        goto magicalize;
@@ -579,10 +706,14 @@ SV *sv;
 GV *gv;
 {
     GV* egv = GvEGV(gv);
-    HV *hv = GvSTASH(egv);
-
+    HV *hv;
+    
+    if (!egv)
+       egv = gv;
+    hv = GvSTASH(egv);
     if (!hv)
        return;
+
     sv_setpv(sv, sv == (SV*)gv ? "*" : "");
     sv_catpv(sv,HvNAME(hv));
     sv_catpvn(sv,"::", 2);
@@ -599,7 +730,7 @@ newIO()
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
-    iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO);
+    iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV);
     SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv));
     return io;
 }
@@ -617,23 +748,23 @@ HV* stash;
     if (!HvARRAY(stash))
        return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
-       for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) {
-           if (entry->hent_key[entry->hent_klen-1] == ':' &&
-               (gv = (GV*)entry->hent_val) && (hv = GvHV(gv)) && HvNAME(hv))
+       for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
+           if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
+               (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
            {
                if (hv != defstash)
                     gv_check(hv);              /* nested package */
            }
-           else if (isALPHA(*entry->hent_key)) {
-               gv = (GV*)entry->hent_val;
-               if (SvMULTI(gv))
+           else if (isALPHA(*HeKEY(entry))) {
+               gv = (GV*)HeVAL(entry);
+               if (GvMULTI(gv))
                    continue;
                curcop->cop_line = GvLINE(gv);
                filegv = GvFILEGV(gv);
                curcop->cop_filegv = filegv;
-               if (filegv && SvMULTI(filegv))  /* Filename began with slash */
+               if (filegv && GvMULTI(filegv))  /* Filename began with slash */
                    continue;
-               warn("Identifier \"%s::%s\" used only once: possible typo",
+               warn("Name \"%s::%s\" used only once: possible typo",
                        HvNAME(stash), GvNAME(gv));
            }
        }
@@ -663,9 +794,8 @@ void
 gp_free(gv)
 GV* gv;
 {
-    IO *io;
-    CV *cv;
     GP* gp;
+    CV* cv;
 
     if (!gv || !(gp = GvGP(gv)))
        return;
@@ -673,18 +803,20 @@ GV* gv;
         warn("Attempt to free unreferenced glob pointers");
         return;
     }
-    if (--gp->gp_refcnt > 0)
+    if (--gp->gp_refcnt > 0) {
+       if (gp->gp_egv == gv)
+           gp->gp_egv = 0;
         return;
+    }
 
     SvREFCNT_dec(gp->gp_sv);
     SvREFCNT_dec(gp->gp_av);
     SvREFCNT_dec(gp->gp_hv);
-    if ((io = gp->gp_io) && SvTYPE(io) != SVTYPEMASK) {
-       do_close(gv,FALSE);
-       SvREFCNT_dec(io);
-    }
+    SvREFCNT_dec(gp->gp_io);
     if ((cv = gp->gp_cv) && !GvCVGEN(gv))
        SvREFCNT_dec(cv);
+    SvREFCNT_dec(gp->gp_form);
+
     Safefree(gp);
     GvGP(gv) = 0;
 }
@@ -725,12 +857,20 @@ HV* stash;
   GV* gv;
   CV* cv;
   MAGIC* mg=mg_find((SV*)stash,'c');
-  AMT *amtp;
+  AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL;
 
   if (mg && (amtp=((AMT*)(mg->mg_ptr)))->was_ok_am == amagic_generation &&
              amtp->was_ok_sub == sub_generation)
       return HV_AMAGIC(stash)? TRUE: FALSE;
   gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE);
+  if (amtp && amtp->table) {
+    int i;
+    for (i=1;i<NofAMmeth*2;i++) {
+      if (amtp->table[i]) {
+       SvREFCNT_dec(amtp->table[i]);
+      }
+    }
+  }
   sv_unmagic((SV*)stash, 'c');
 
   DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) );
@@ -742,6 +882,7 @@ HV* stash;
     AMT amt;
     SV* sv;
     SV** svp;
+    GV** gvp;
 
 /*  if (*(svp)==(SV*)amagic_generation && *(svp+1)==(SV*)sub_generation) {
       DEBUG_o( deb("Overload magic in package %s up-to-date\n",HvNAME(stash))
@@ -766,12 +907,12 @@ HV* stash;
 
       if ( (cp=((char**)(*AMG_names))[i]) ) {
         svp=(SV**)hv_fetch(hv,cp,strlen(cp),FALSE);
-        if (svp && ((sv = *svp) != (GV*)&sv_undef)) {
+        if (svp && ((sv = *svp) != &sv_undef)) {
           switch (SvTYPE(sv)) {
             default:
               if (!SvROK(sv)) {
                 if (!SvOK(sv)) break;
-               gv = gv_fetchmethod(curcop->cop_stash, SvPV(sv, na));
+               gv = gv_fetchmethod(stash, SvPV(sv, na));
                 if (gv) cv = GvCV(gv);
                 break;
               }
@@ -793,13 +934,13 @@ HV* stash;
           }
           if (cv) filled=1;
          else {
-           die("Method for operation %s not found in package %s during blessing\n",
+           die("Method for operation %s not found in package %.256s during blessing\n",
                cp,HvNAME(stash));
            return FALSE;
          }
         }
       }
-      amt.table[i]=cv;
+      amt.table[i]=(CV*)SvREFCNT_inc(cv);
     }
     sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(amt));
     if (filled) {
@@ -828,17 +969,15 @@ int flags;
   CV **cvp=NULL, **ocvp=NULL;
   AMT *amtp, *oamtp;
   int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
-  int postpr=0;
+  int postpr=0, inc_dec_ass=0, assignshift=assign?1:0;
   HV* stash;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c'))
       && (ocvp = cvp = ((oamtp=amtp=(AMT*)mg->mg_ptr)->table))
-      && (assign ?
-             ((cv = cvp[off=method+1]) 
-             || ( amtp->fallback > AMGfallNEVER && /* fallback to
-                                                    * usual method */
-                 (fl = 1, cv = cvp[off=method]))):
-             (1 && (cv = cvp[off=method]))  )) {
+      && ((cv = cvp[off=method+assignshift]) 
+         || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
+                                                         * usual method */
+                 (fl = 1, cv = cvp[off=method])))) {
     lr = -1;                   /* Call method for left argument */
   } else {
     if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
@@ -847,13 +986,13 @@ int flags;
       /* look for substituted methods */
         switch (method) {
         case inc_amg:
-          if ((cv = cvp[off=add_ass_amg]) 
+          if (((cv = cvp[off=add_ass_amg]) && (inc_dec_ass=1))
               || ((cv = cvp[off=add_amg]) && (postpr=1))) {
             right = &sv_yes; lr = -1; assign = 1;
           }
           break;
         case dec_amg:
-          if ((cv = cvp[off=subtr_ass_amg]) 
+          if (((cv = cvp[off=subtr_ass_amg])  && (inc_dec_ass=1))
               || ((cv = cvp[off=subtr_amg]) && (postpr=1))) {
             right = &sv_yes; lr = -1; assign = 1;
           }
@@ -867,24 +1006,46 @@ int flags;
         case string_amg:
           (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
           break;
+ case not_amg:
+   (void)((cv = cvp[off=bool__amg]) 
+         || (cv = cvp[off=numer_amg])
+         || (cv = cvp[off=string_amg]));
+   postpr = 1;
+   break;
+        case copy_amg:
+          {
+            SV* ref=SvRV(left);
+            if (!SvROK(ref) && SvTYPE(ref) <= SVt_PVMG) { /* Just to be
+                                                     * extra
+                                                     * causious,
+                                                     * maybe in some
+                                                     * additional
+                                                     * cases sv_setsv
+                                                     * is safe too */
+               SV* newref = newSVsv(ref);
+               SvOBJECT_on(newref);
+               SvSTASH(newref) = (HV*)SvREFCNT_inc(SvSTASH(ref));
+               return newref;
+            }
+          }
+          break;
         case abs_amg:
-          if ((cvp[off1=lt_amg] || cvp[off1=lt_amg]) 
+          if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) 
               && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) {
+            SV* nullsv=sv_2mortal(newSViv(0));
             if (off1==lt_amg) {
-              SV* lessp = amagic_call(left,
-                                      sv_2mortal(newSViv(0)),
+              SV* lessp = amagic_call(left,nullsv,
                                       lt_amg,AMGf_noright);
               logic = SvTRUE(lessp);
             } else {
-              SV* lessp = amagic_call(left,
-                                      sv_2mortal(newSViv(0)),
+              SV* lessp = amagic_call(left,nullsv,
                                       ncmp_amg,AMGf_noright);
               logic = (SvNV(lessp) < 0);
             }
             if (logic) {
               if (off==subtr_amg) {
                 right = left;
-                left = sv_2mortal(newSViv(0));
+                left = nullsv;
                 lr = 1;
               }
             } else {
@@ -909,7 +1070,8 @@ int flags;
               && (cv = cvp[off=method])) { /* Method for right
                                             * argument found */
       lr=1;
-    } else if (((ocvp && oamtp->fallback > AMGfallNEVER && (cvp=ocvp)) 
+    } else if (((ocvp && oamtp->fallback > AMGfallNEVER 
+                && (cvp=ocvp) && (lr = -1)) 
                || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
@@ -947,9 +1109,9 @@ int flags;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
        notfound = 1; lr = 1;
       } else {
-       char tmpstr[512];
-       sprintf(tmpstr,"Operation `%s': no method found,\n\tleft argument %s%200s,\n\tright argument %s%200s",
-                     ((char**)AMG_names)[off],
+        if (off==-1) off=method;
+       sprintf(buf, "Operation `%s': no method found,\n\tleft argument %s%.256s,\n\tright argument %s%.256s",
+                     ((char**)AMG_names)[method + assignshift],
                      SvAMAGIC(left)? 
                        "in overloaded package ":
                        "has no overloaded magic",
@@ -963,24 +1125,34 @@ int flags;
                        HvNAME(SvSTASH(SvRV(right))):
                        "");
        if (amtp && amtp->fallback >= AMGfallYES) {
-         DEBUG_o( deb(tmpstr) );
+         DEBUG_o( deb(buf) );
        } else {
-         die(tmpstr);
+         die(buf);
        }
        return NULL;
       }
     }
   }
   if (!notfound) {
-    DEBUG_o( deb("Operation `%s': method for %s argument found in package %s%s\n",
+    DEBUG_o( deb("Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %.256s%s\n",
                 ((char**)AMG_names)[off],
-                (lr? "right": "left"),
+                method+assignshift==off? "" :
+                            " (initially `",
+                method+assignshift==off? "" :
+                            ((char**)AMG_names)[method+assignshift],
+                method+assignshift==off? "" : "')",
+                flags & AMGf_unary? "" :
+                  lr==1 ? " for right argument": " for left argument",
+                flags & AMGf_unary? " for argument" : "",
                 HvNAME(stash), 
                 fl? ",\n\tassignment variant used": "") );
-    /* Since we use shallow copy, we need to dublicate the contents,
-       probably we need also to use user-supplied version of coping?
-       */
-    if (assign || method==inc_amg || method==dec_amg) RvDEEPCP(left);
+    /* Since we use shallow copy during assignment, we need
+     * to dublicate the contents, probably calling user-supplied
+     * version of copy operator
+     */
+    if ((method + assignshift==off 
+        && (assign || method==inc_amg || method==dec_amg))
+       || inc_dec_ass) RvDEEPCP(left);
   }
   {
     dSP;
@@ -995,6 +1167,8 @@ int flags;
     ENTER;
     SAVESPTR(op);
     op = (OP *) &myop;
+    if (perldb && curstash != debstash)
+       op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
     pp_pushmark();
 
@@ -1003,13 +1177,13 @@ int flags;
     PUSHs(lr>0? left: right);
     PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no));
     if (notfound) {
-      PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[off],0)) );
+      PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[method + assignshift],0)) );
     }
     PUSHs((SV*)cv);
     PUTBACK;
 
     if (op = pp_entersub())
-      run();
+      runops();
     LEAVE;
     SPAGAIN;
 
@@ -1045,8 +1219,15 @@ int flags;
       case inc_amg:
       case dec_amg:
        SvSetSV(left,res); return res; break;
+      case not_amg:
+ans=!SvOK(res); break;
       }
       return ans? &sv_yes: &sv_no;
+    } else if (method==copy_amg) {
+      if (!SvROK(res)) {
+       die("Copy method did not return a reference");
+      }
+      return SvREFCNT_inc(SvRV(res));
     } else {
       return res;
     }