oct() and hex()

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 1851f8b..33e6cd2 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -46,9 +46,9 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        Perl_croak(aTHX_ "Bad symbol for filehandle");
     if (!GvIOp(gv)) {
-#ifdef GV_SHARED_CHECK
-        if (GvSHARED(gv)) {
-            Perl_croak(aTHX_ "Bad symbol for filehandle (GV is shared)");
+#ifdef GV_UNIQUE_CHECK
+        if (GvUNIQUE(gv)) {
+            Perl_croak(aTHX_ "Bad symbol for filehandle (GV is unique)");
         }
 #endif
        GvIOp(gv) = newIO();
@@ -128,13 +128,13 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        CvGV(GvCV(gv)) = gv;
        CvFILE_set_from_cop(GvCV(gv), PL_curcop);
        CvSTASH(GvCV(gv)) = PL_curstash;
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
        CvOWNER(GvCV(gv)) = 0;
        if (!CvMUTEXP(GvCV(gv))) {
            New(666, CvMUTEXP(GvCV(gv)), 1, perl_mutex);
            MUTEX_INIT(CvMUTEXP(GvCV(gv)));
        }
-#endif /* USE_THREADS */
+#endif /* USE_5005THREADS */
        if (proto) {
            sv_setpv((SV*)GvCV(gv), proto);
            Safefree(proto);
@@ -439,7 +439,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
          "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
             HvNAME(stash), (int)len, name);
 
-#ifndef USE_THREADS
+#ifndef USE_5005THREADS
     if (CvXSUB(cv)) {
         /* rather than lookup/init $AUTOLOAD here
          * only to have the XSUB do another lookup for $AUTOLOAD
@@ -463,14 +463,14 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
     vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
     ENTER;
 
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     sv_lock((SV *)varstash);
 #endif
     if (!isGV(vargv))
        gv_init(vargv, varstash, autoload, autolen, FALSE);
     LEAVE;
     varsv = GvSV(vargv);
-#ifdef USE_THREADS
+#ifdef USE_5005THREADS
     sv_lock(varsv);
 #endif
     sv_setpv(varsv, HvNAME(stash));
@@ -938,6 +938,17 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '7':
     case '8':
     case '9':
+       /* ensures variable is only digits */
+       /* ${"1foo"} fails this test (and is thus writeable) */
+       /* added by japhy, but borrowed from is_gv_magical */
+
+       if (len > 1) {
+           const char *end = name + len;
+           while (--end > name) {
+               if (!isDIGIT(*end)) return gv;
+           }
+       }
+
       ro_magicalize:
        SvREADONLY_on(GvSV(gv));
       magicalize: