]> git.vpit.fr Git - perl/modules/Sub-Op.git/blobdiff - Op.xs
Handle existing constant subs
[perl/modules/Sub-Op.git] / Op.xs
diff --git a/Op.xs b/Op.xs
index 89716e7602a4ed44c9719441ebd3e2fb3aae26fe..cdcc89af7a2d45946ff78f87bf3f87190316c42e 100644 (file)
--- a/Op.xs
+++ b/Op.xs
@@ -381,3 +381,15 @@ PPCODE:
   XSRETURN_UNDEF;
  ST(0) = sv_2mortal(newSVpvn(&on->buf, on->len));
  XSRETURN(1);
+
+void
+_constant_sub(SV *sv)
+PROTOTYPE: $
+PPCODE:
+ if (!SvROK(sv))
+  XSRETURN_UNDEF;
+ sv = SvRV(sv);
+ if (SvTYPE(sv) < SVt_PVCV)
+  XSRETURN_UNDEF;
+ ST(0) = sv_2mortal(newSVuv(CvCONST(sv)));
+ XSRETURN(1);