This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
test the resetting of refcnt for immortals
authorDavid Mitchell <davem@iabyn.com>
Tue, 18 Dec 2012 23:41:29 +0000 (23:41 +0000)
committerDavid Mitchell <davem@iabyn.com>
Tue, 18 Dec 2012 23:45:17 +0000 (23:45 +0000)
PL_sv_undef etc get given a very high ref count, which if it ever reaches
zero, is set back to a high value. On debugging builds, use a lower value
(1000) so that the resetting code gets exercised occasionally.

Also, replace literal (~(U32)0)/2 with the constant SvREFCNT_IMMORTAL.

perl.c
sv.c
sv.h

diff --git a/perl.c b/perl.c
index 00c48bd..01b0bf1 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -241,7 +241,7 @@ perl_construct(pTHXx)
     init_constants();
 
     SvREADONLY_on(&PL_sv_placeholder);
-    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL;
 
     PL_sighandlerp = (Sighandler_t) Perl_sighandler;
 #ifdef PERL_USES_PL_PIDSTATUS
diff --git a/sv.c b/sv.c
index 50f8e66..3e3a5c7 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6411,7 +6411,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 #endif
            if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
                /* make sure SvREFCNT(sv)==0 happens very seldom */
-               SvREFCNT(sv) = (~(U32)0)/2;
+               SvREFCNT(sv) = SvREFCNT_IMMORTAL;
                continue;
            }
            break;
@@ -6577,7 +6577,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
 #endif
         if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
             /* make sure SvREFCNT(sv)==0 happens very seldom */
-            SvREFCNT(sv) = (~(U32)0)/2;
+            SvREFCNT(sv) = SvREFCNT_IMMORTAL;
             return;
         }
         sv_clear(sv);
@@ -6598,7 +6598,7 @@ Perl_sv_free2(pTHX_ SV *const sv, const U32 rc)
         return;
     if (SvREADONLY(sv) && SvIMMORTAL(sv)) {
         /* make sure SvREFCNT(sv)==0 happens very seldom */
-        SvREFCNT(sv) = (~(U32)0)/2;
+        SvREFCNT(sv) = SvREFCNT_IMMORTAL;
         return;
     }
     if (ckWARN_d(WARN_INTERNAL)) {
@@ -13913,18 +13913,18 @@ Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
 void
 Perl_init_constants(pTHX)
 {
-    SvREFCNT(&PL_sv_undef)     = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_undef)     = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_undef)      = SVf_READONLY|SVt_NULL;
     SvANY(&PL_sv_undef)                = NULL;
 
     SvANY(&PL_sv_no)           = new_XPVNV();
-    SvREFCNT(&PL_sv_no)                = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_no)                = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_no)         = SVt_PVNV|SVf_READONLY
                                  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
                                  |SVp_POK|SVf_POK;
 
     SvANY(&PL_sv_yes)          = new_XPVNV();
-    SvREFCNT(&PL_sv_yes)       = (~(U32)0)/2;
+    SvREFCNT(&PL_sv_yes)       = SvREFCNT_IMMORTAL;
     SvFLAGS(&PL_sv_yes)                = SVt_PVNV|SVf_READONLY
                                  |SVp_IOK|SVf_IOK|SVp_NOK|SVf_NOK
                                  |SVp_POK|SVf_POK;
diff --git a/sv.h b/sv.h
index e248ba7..09489b7 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -2061,6 +2061,13 @@ alternative is to call C<sv_grow> if you are not sure of the type of SV.
 
 #define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_placeholder)
 
+#ifdef DEBUGGING
+   /* exercise the immortal resurrection code in sv_free2() */
+#  define SvREFCNT_IMMORTAL 1000
+#else
+#  define SvREFCNT_IMMORTAL ((~(U32)0)/2)
+#endif
+
 /*
 =for apidoc Am|SV *|boolSV|bool b