s/YYLEX_PARAM/YYLEXPARAM/

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

diff --git a/gv.c b/gv.c
index 531fbb5..a3e8d88 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -19,8 +19,6 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-EXT char rcsid[];
-
 GV *
 gv_AVadd(register GV *gv)
 {
@@ -124,9 +122,10 @@ gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi)
        CvSTASH(GvCV(gv)) = PL_curstash;
 #ifdef USE_THREADS
        CvOWNER(GvCV(gv)) = 0;
-       if (!CvMUTEXP(GvCV(gv)))
+       if (!CvMUTEXP(GvCV(gv))) {
            New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
-       MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+           MUTEX_INIT(CvMUTEXP(GvCV(gv)));
+       }
 #endif /* USE_THREADS */
        if (proto) {
            sv_setpv((SV*)GvCV(gv), proto);
@@ -223,8 +222,9 @@ gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level)
            SV* sv = *svp++;
            HV* basestash = gv_stashsv(sv, FALSE);
            if (!basestash) {
-               if (PL_dowarn)
-                   warn("Can't locate package %s for @%s::ISA",
+               dTHR;           /* just for ckWARN */
+               if (ckWARN(WARN_MISC))
+                   warner(WARN_MISC, "Can't locate package %s for @%s::ISA",
                        SvPVX(sv), HvNAME(stash));
                continue;
            }
@@ -341,6 +341,7 @@ gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload)
 GV*
 gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
 {
+    dTHR;
     static char autoload[] = "AUTOLOAD";
     static STRLEN autolen = 8;
     GV* gv;
@@ -358,8 +359,9 @@ gv_autoload4(HV *stash, char *name, STRLEN len, I32 method)
     /*
      * Inheriting AUTOLOAD for non-methods works ... for now.
      */
-    if (PL_dowarn && !method && (GvCVGEN(gv) || GvSTASH(gv) != stash))
-       warn(
+    if (ckWARN(WARN_DEPRECATED) && !method && 
+       (GvCVGEN(gv) || GvSTASH(gv) != stash))
+       warner(WARN_DEPRECATED,
          "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
             HvNAME(stash), (int)len, name);
 
@@ -498,7 +500,9 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     /* No stash in name, so see how we can default */
 
     if (!stash) {
-       if (isIDFIRST(*name)) {
+       if (isIDFIRST(*name)
+           || (IN_UTF8 && ((*name & 0xc0) == 0xc0) && isIDFIRST_utf8((U8*)name)))
+       {
            bool global = FALSE;
 
            if (isUPPER(*name)) {
@@ -564,7 +568,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     if (!stash) {
        if (!add)
            return Nullgv;
-       if (add & ~GV_ADDMULTI) {
+       {
            char sv_type_char = ((sv_type == SVt_PV) ? '$'
                                 : (sv_type == SVt_PVAV) ? '@'
                                 : (sv_type == SVt_PVHV) ? '%'
@@ -728,16 +732,23 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
            }
        }
        goto magicalize;
+    case '-':
+       if (len > 1)
+           break;
+       else {
+            AV* av = GvAVn(gv);
+            sv_magic((SV*)av, Nullsv, 'D', Nullch, 0);
+        }
+       goto magicalize;
     case '#':
     case '*':
-       if (PL_dowarn && len == 1 && sv_type == SVt_PV)
-           warn("Use of $%s is deprecated", name);
+       if (ckWARN(WARN_DEPRECATED) && len == 1 && sv_type == SVt_PV)
+           warner(WARN_DEPRECATED, "Use of $%s is deprecated", name);
        /* FALL THROUGH */
     case '[':
     case '^':
     case '~':
     case '=':
-    case '-':
     case '%':
     case '.':
     case '(':
@@ -749,6 +760,7 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '/':
     case '|':
     case '\001':
+    case '\002':
     case '\004':
     case '\005':
     case '\006':
@@ -761,8 +773,19 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
        if (len > 1)
            break;
        goto magicalize;
+    case '\023':
+       if (len > 1)
+           break;
+       goto ro_magicalize;
 
     case '+':
+       if (len > 1)
+           break;
+       else {
+            AV* av = GvAVn(gv);
+            sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0);
+        }
+       /* FALL THROUGH */
     case '1':
     case '2':
     case '3':
@@ -772,7 +795,6 @@ gv_fetchpv(char *nambeg, I32 add, I32 sv_type)
     case '7':
     case '8':
     case '9':
-    case '\023':
       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize:
@@ -887,7 +909,8 @@ gv_check(HV *stash)
                PL_curcop->cop_filegv = filegv;
                if (filegv && GvMULTI(filegv))  /* Filename began with slash */
                    continue;
-               warn("Name \"%s::%s\" used only once: possible typo",
+               warner(WARN_ONCE,
+                       "Name \"%s::%s\" used only once: possible typo",
                        HvNAME(stash), GvNAME(gv));
            }
        }