X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/af09ea45cb052770572c0a2caa4e487853f703c8..23268c55726c8c15e532ea9bd7aa56106f2c2279:/gv.c

diff --git a/gv.c b/gv.c
index 0041693..e4951a0 100644
--- 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();
@@ -126,7 +126,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 
 	PL_sub_generation++;
 	CvGV(GvCV(gv)) = gv;
-	CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
+	CvFILE_set_from_cop(GvCV(gv), PL_curcop);
 	CvSTASH(GvCV(gv)) = PL_curstash;
 #ifdef USE_THREADS
 	CvOWNER(GvCV(gv)) = 0;
@@ -195,8 +195,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 	    return 0;
     }
 
-    if (!HvNAME(stash))
-        Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
     if ((level > 100) || (level < -100))
 	Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
 	      name, HvNAME(stash));
@@ -449,7 +447,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
          * pass along the same data via some unused fields in the CV
          */
         CvSTASH(cv) = stash;
-        SvPVX(cv) = (char *)name; /* cast to loose constness warning */
+        SvPVX(cv) = (char *)name; /* cast to lose constness warning */
         SvCUR(cv) = len;
         return gv;
     }
@@ -897,6 +895,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '\006':	/* $^F */
     case '\010':	/* $^H */
     case '\011':	/* $^I, NOT \t in EBCDIC */
+    case '\016':        /* $^N */
     case '\020':	/* $^P */
     case '\024':	/* $^T */
 	if (len > 1)
@@ -1077,7 +1076,7 @@ Perl_gv_check(pTHX_ HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
 	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
 	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
-		(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
+		(gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)))
 	    {
 		if (hv != PL_defstash && hv != stash)
 		     gv_check(hv);              /* nested package */
@@ -1230,7 +1229,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table);
   AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL;
   AMT amt;
-  STRLEN n_a;
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
@@ -1284,7 +1282,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 		GV *ngv;
 		
 		DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
-			     SvPV(GvSV(gv), n_a), cp, HvNAME(stash)) );
+			     SvPV_nolen(GvSV(gv)), cp, HvNAME(stash)) );
 		if (!SvPOK(GvSV(gv))
 		    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
 						       FALSE)))
@@ -1356,22 +1354,29 @@ SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {
   MAGIC *mg;
-  CV *cv;
+  CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
-  AMT *amtp, *oamtp;
-  int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
+  AMT *amtp=NULL, *oamtp=NULL;
+  int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
   int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
-  HV* stash;
+#ifdef DEBUGGING
+  int fl=0;
+#endif
+  HV* stash=NULL;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
-      && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),
-			PERL_MAGIC_overload_table))
+      && (stash = SvSTASH(SvRV(left)))
+      && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
 			: (CV **) NULL))
       && ((cv = cvp[off=method+assignshift])
 	  || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
 						          * usual method */
-		  (fl = 1, cv = cvp[off=method])))) {
+		  (
+#ifdef DEBUGGING
+		   fl = 1,
+#endif 
+		   cv = cvp[off=method])))) {
     lr = -1;			/* Call method for left argument */
   } else {
     if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
@@ -1477,8 +1482,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	 }
 	 if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
-	       && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),
-			PERL_MAGIC_overload_table))
+	       && (stash = SvSTASH(SvRV(right)))
+	       && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
 	       && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
 			  ? (amtp = (AMT*)mg->mg_ptr)->table
 			  : (CV **) NULL))
@@ -1564,21 +1569,23 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       force_cpy = force_cpy || assign;
     }
   }
+#ifdef DEBUGGING
   if (!notfound) {
-    DEBUG_o( Perl_deb(aTHX_
-  "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
-		 AMG_id2name(off),
-		 method+assignshift==off? "" :
-		             " (initially `",
-		 method+assignshift==off? "" :
-		             AMG_id2name(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": "") );
+    DEBUG_o(Perl_deb(aTHX_
+		     "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
+		     AMG_id2name(off),
+		     method+assignshift==off? "" :
+		     " (initially `",
+		     method+assignshift==off? "" :
+		     AMG_id2name(method+assignshift),
+		     method+assignshift==off? "" : "')",
+		     flags & AMGf_unary? "" :
+		     lr==1 ? " for right argument": " for left argument",
+		     flags & AMGf_unary? " for argument" : "",
+		     stash ? HvNAME(stash) : "null",
+		     fl? ",\n\tassignment variant used": "") );
   }
+#endif
     /* Since we use shallow copy during assignment, we need
      * to dublicate the contents, probably calling user-supplied
      * version of copy operator
@@ -1647,7 +1654,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     CATCH_SET(oldcatch);
 
     if (postpr) {
-      int ans;
+      int ans=0;
       switch (method) {
       case le_amg:
       case sle_amg:
@@ -1767,6 +1774,7 @@ Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
     case '\010':   /* $^H */
     case '\011':   /* $^I, NOT \t in EBCDIC */
     case '\014':   /* $^L */
+    case '\016':   /* $^N */
     case '\020':   /* $^P */
     case '\023':   /* $^S */
     case '\024':   /* $^T */