]> git.vpit.fr Git - perl/modules/Lexical-Types.git/blobdiff - Types.xs
Fix the refcount of orig_pkg when type_pkg defaults to it
[perl/modules/Lexical-Types.git] / Types.xs
index 7d50b19fdbbf1a393773dbee7a5ad6e840ac3484..8895acb0b371904adb1598074aa80724210154e2 100644 (file)
--- a/Types.xs
+++ b/Types.xs
@@ -6,6 +6,9 @@
 #include "perl.h"
 #include "XSUB.h"
 
+#define __PACKAGE__     "Lexical::Types"
+#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
+
 /* --- Compatibility wrappers ---------------------------------------------- */
 
 #define LT_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
@@ -32,9 +35,6 @@
 # define HvNAMELEN_get(H) strlen(HvNAME_get(H))
 #endif
 
-#define __PACKAGE__     "Lexical::Types"
-#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
-
 /* --- Helpers ------------------------------------------------------------- */
 
 /* ... Hints ............................................................... */
@@ -195,8 +195,8 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) {
  if (stash && (hint = lt_hint())) {
   SV *orig_pkg  = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash));
   SV *orig_meth = lt_default_meth;
-  SV *type_pkg  = orig_pkg;
-  SV *type_meth = orig_meth;
+  SV *type_pkg  = NULL;
+  SV *type_meth = NULL;
   SV *code      = INT2PTR(SV *, SvUVX(hint));
 
   SvREADONLY_on(orig_pkg);
@@ -243,8 +243,15 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) {
    LEAVE;
   }
 
-  if (type_meth == orig_meth)
+  if (!type_pkg) {
+   type_pkg = orig_pkg;
+   SvREFCNT_inc(orig_pkg);
+  }
+
+  if (!type_meth) {
+   type_meth = orig_meth;
    SvREFCNT_inc(orig_meth);
+  }
 
   lt_pp_padsv_save();