X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/305b86516461e93877909338ac3642c6ac09b651..435847ca4606aec9adb049a368cde586bfb84262:/pp.c

diff --git a/pp.c b/pp.c
index 67bf36b..0e92254 100644
--- a/pp.c
+++ b/pp.c
@@ -249,6 +249,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict,
 			const char * const name = CopSTASHPV(PL_curcop);
 			gv = newGVgen_flags(name,
                                 HvNAMEUTF8(CopSTASH(PL_curcop)) ? SVf_UTF8 : 0 );
+			SvREFCNT_inc_simple_void_NN(gv);
 		    }
 		    prepare_SV_for_RV(sv);
 		    SvRV_set(sv, MUTABLE_SV(gv));
@@ -471,7 +472,9 @@ PP(pp_rv2cv)
     CV *cv = sv_2cv(TOPs, &stash_unused, &gv, flags);
     if (cv) NOOP;
     else if ((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) {
-	cv = MUTABLE_CV(gv);
+	cv = SvTYPE(SvRV(gv)) == SVt_PVCV
+	    ? MUTABLE_CV(SvRV(gv))
+	    : MUTABLE_CV(gv);
     }    
     else
 	cv = MUTABLE_CV(&PL_sv_undef);
@@ -570,7 +573,6 @@ S_refto(pTHX_ SV *sv)
 	SvREFCNT_inc_void_NN(sv);
     }
     else if (SvPADTMP(sv)) {
-        assert(!IS_PADGV(sv));
         sv = newSVsv(sv);
     }
     else {
@@ -972,7 +974,8 @@ PP(pp_undef)
     if (!sv)
 	RETPUSHUNDEF;
 
-    SV_CHECK_THINKFIRST_COW_DROP(sv);
+    if (SvTHINKFIRST(sv))
+	sv_force_normal_flags(sv, SV_COW_DROP_PV|SV_IMMEDIATE_UNREF);
 
     switch (SvTYPE(sv)) {
     case SVt_NULL:
@@ -997,18 +1000,8 @@ PP(pp_undef)
                            ));
 	/* FALLTHROUGH */
     case SVt_PVFM:
-	{
 	    /* let user-undef'd sub keep its identity */
-	    GV* const gv = CvGV((const CV *)sv);
-	    HEK * const hek = CvNAME_HEK((CV *)sv);
-	    if (hek) share_hek_hek(hek);
-	    cv_undef(MUTABLE_CV(sv));
-	    if (gv) CvGV_set(MUTABLE_CV(sv), gv);
-	    else if (hek) {
-		SvANY((CV *)sv)->xcv_gv_u.xcv_hek = hek;
-		CvNAMED_on(sv);
-	    }
-	}
+	cv_undef_flags(MUTABLE_CV(sv), CV_UNDEF_KEEP_NAME);
 	break;
     case SVt_PVGV:
 	assert(isGV_with_GP(sv));
@@ -1715,7 +1708,6 @@ PP(pp_repeat)
 #else
                 if (*SP) {
                    if (mod && SvPADTMP(*SP)) {
-                       assert(!IS_PADGV(*SP));
                        *SP = sv_mortalcopy(*SP);
                    }
 		   SvTEMP_off((*SP));
@@ -2684,45 +2676,41 @@ PP(pp_atan2)
 PP(pp_sin)
 {
     dSP; dTARGET;
-    int amg_type = sin_amg;
+    int amg_type = fallback_amg;
     const char *neg_report = NULL;
-    NV (*func)(NV) = Perl_sin;
     const int op_type = PL_op->op_type;
 
     switch (op_type) {
-    case OP_COS:
-	amg_type = cos_amg;
-	func = Perl_cos;
-	break;
-    case OP_EXP:
-	amg_type = exp_amg;
-	func = Perl_exp;
-	break;
-    case OP_LOG:
-	amg_type = log_amg;
-	func = Perl_log;
-	neg_report = "log";
-	break;
-    case OP_SQRT:
-	amg_type = sqrt_amg;
-	func = Perl_sqrt;
-	neg_report = "sqrt";
-	break;
+    case OP_SIN:  amg_type = sin_amg; break;
+    case OP_COS:  amg_type = cos_amg; break;
+    case OP_EXP:  amg_type = exp_amg; break;
+    case OP_LOG:  amg_type = log_amg;  neg_report = "log";  break;
+    case OP_SQRT: amg_type = sqrt_amg; neg_report = "sqrt"; break;
     }
 
+    assert(amg_type != fallback_amg);
 
     tryAMAGICun_MG(amg_type, 0);
     {
       SV * const arg = POPs;
       const NV value = SvNV_nomg(arg);
-      if (neg_report) {
+      NV result = NV_NAN;
+      if (neg_report) { /* log or sqrt */
 	  if (op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)) {
 	      SET_NUMERIC_STANDARD();
 	      /* diag_listed_as: Can't take log of %g */
 	      DIE(aTHX_ "Can't take %s of %"NVgf, neg_report, value);
 	  }
       }
-      XPUSHn(func(value));
+      switch (op_type) {
+      default:
+      case OP_SIN:  result = Perl_sin(value);  break;
+      case OP_COS:  result = Perl_cos(value);  break;
+      case OP_EXP:  result = Perl_exp(value);  break;
+      case OP_LOG:  result = Perl_log(value);  break;
+      case OP_SQRT: result = Perl_sqrt(value); break;
+      }
+      XPUSHn(result);
       RETURN;
     }
 }
@@ -3356,23 +3344,32 @@ PP(pp_chr)
     SV *top = POPs;
 
     SvGETMAGIC(top);
-    if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
-     && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
-	 ||
-	 ((SvNOKp(top) || (SvOK(top) && !SvIsUV(top)))
-	  && SvNV_nomg(top) < 0.0))) {
+    if (SvNOK(top) && Perl_isinfnan(SvNV(top))) {
+        if (ckWARN(WARN_UTF8)) {
+            Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                        "Invalid number (%"NVgf") in chr", SvNV(top));
+        }
+        value = UNICODE_REPLACEMENT;
+    }
+    else {
+        if (!IN_BYTES /* under bytes, chr(-1) eq chr(0xff), etc. */
+            && ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
+                ||
+                ((SvNOKp(top) || (SvOK(top) && !SvIsUV(top)))
+                 && SvNV_nomg(top) < 0.0))) {
 	    if (ckWARN(WARN_UTF8)) {
 		if (SvGMAGICAL(top)) {
 		    SV *top2 = sv_newmortal();
 		    sv_setsv_nomg(top2, top);
 		    top = top2;
 		}
-		Perl_warner(aTHX_ packWARN(WARN_UTF8),
-			   "Invalid negative number (%"SVf") in chr", SVfARG(top));
-	    }
-	    value = UNICODE_REPLACEMENT;
-    } else {
-	value = SvUV_nomg(top);
+                Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                            "Invalid negative number (%"SVf") in chr", SVfARG(top));
+            }
+            value = UNICODE_REPLACEMENT;
+        } else {
+            value = SvUV_nomg(top);
+        }
     }
 
     SvUPGRADE(TARG,SVt_PV);
@@ -4959,7 +4956,6 @@ PP(pp_lslice)
 	    if (!(*lelem = firstrelem[ix]))
 		*lelem = &PL_sv_undef;
 	    else if (mod && SvPADTMP(*lelem)) {
-                assert(!IS_PADGV(*lelem));
 		*lelem = firstrelem[ix] = sv_mortalcopy(*lelem);
             }
 	}