changelog for RT#99102 fix

[p5sagit/Devel-Declare.git] / Declare.xs

diff --git a/Declare.xs b/Declare.xs
index 44d0a72..9b84045 100644 (file)
--- a/Declare.xs
+++ b/Declare.xs
@@ -1,3 +1,4 @@
+#define PERL_NO_GET_CONTEXT 1
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -256,9 +257,9 @@ static void call_done_declare(pTHX) {
   if (DD_DEBUG_TRACE) {
     printf("Deconstructing declare\n");
     printf("PL_bufptr: %s\n", PL_bufptr);
-    printf("bufend at: %i\n", PL_bufend - PL_bufptr);
+    printf("bufend at: %i\n", (int)(PL_bufend - PL_bufptr));
     printf("linestr: %s\n", SvPVX(PL_linestr));
-    printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
+    printf("linestr len: %i\n", (int)(PL_bufend - SvPVX(PL_linestr)));
   }
 
   ENTER;
@@ -273,20 +274,35 @@ static void call_done_declare(pTHX) {
 
   if (DD_DEBUG_TRACE) {
     printf("PL_bufptr: %s\n", PL_bufptr);
-    printf("bufend at: %i\n", PL_bufend - PL_bufptr);
+    printf("bufend at: %i\n", (int)(PL_bufend - PL_bufptr));
     printf("linestr: %s\n", SvPVX(PL_linestr));
-    printf("linestr len: %i\n", PL_bufend - SvPVX(PL_linestr));
-    printf("actual len: %i\n", strlen(PL_bufptr));
+    printf("linestr len: %i\n", (int)(PL_bufend - SvPVX(PL_linestr)));
+    printf("actual len: %i\n", (int)strlen(PL_bufptr));
   }
 }
 
 static int dd_handle_const(pTHX_ char *name);
 
+#ifdef CV_NAME_NOTQUAL /* 5.21.5 */
+# define Gv_or_CvNAME(g) (isGV(g) \
+               ? GvNAME(g) \
+               : SvPV_nolen(cv_name((CV *)SvRV(g), NULL, CV_NAME_NOTQUAL)))
+#elif defined(CvNAMED) /* 5.21.4 */
+# define Gv_or_CvNAME(g) (isGV(g) \
+                            ? GvNAME(g) \
+                            : CvNAMED(SvRV(g)) \
+                                ? HEK_KEY(CvNAME_HEK((CV *)SvRV(g))) \
+                                : GvNAME(CvGV(SvRV(g))))
+#else
+# define Gv_or_CvNAME(g) GvNAME(g)
+#endif
+
 /* replacement PL_check rv2cv entry */
 
 STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
   OP* kid;
   int dd_flags;
+  char *gvname;
 
   PERL_UNUSED_VAR(user_data);
 
@@ -303,11 +319,17 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
   if (kid->op_type != OP_GV) /* not a GV so ignore */
     return o;
 
+  if (!isGV(kGVOP_gv)
+   && (!SvROK(kGVOP_gv) || SvTYPE(SvRV(kGVOP_gv)) != SVt_PVCV))
+    return o;
+
+  gvname = Gv_or_CvNAME(kGVOP_gv);
+
   if (DD_DEBUG_TRACE) {
-    printf("Checking GV %s -> %s\n", HvNAME(GvSTASH(kGVOP_gv)), GvNAME(kGVOP_gv));
+    printf("Checking GV %s -> %s\n", HvNAME(GvSTASH(kGVOP_gv)), gvname);
   }
 
-  dd_flags = dd_is_declarator(aTHX_ GvNAME(kGVOP_gv));
+  dd_flags = dd_is_declarator(aTHX_ gvname);
 
   if (dd_flags == -1)
     return o;
@@ -319,23 +341,23 @@ STATIC OP *dd_ck_rv2cv(pTHX_ OP *o, void *user_data) {
 
 #if DD_CONST_VIA_RV2CV
   if (PL_expect != XOPERATOR) {
-    if (!dd_handle_const(aTHX_ GvNAME(kGVOP_gv)))
+    if (!dd_handle_const(aTHX_ Gv_or_CvNAME(kGVOP_gv)))
       return o;
     CopLINE(PL_curcop) = PL_copline;
     /* The parser behaviour that we're simulating depends on what comes
        after the declarator. */
-    if (*skipspace(PL_bufptr + strlen(GvNAME(kGVOP_gv))) != '(') {
+    if (*skipspace(PL_bufptr + strlen(gvname)) != '(') {
       if (in_declare) {
         call_done_declare(aTHX);
       } else {
-        dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv));
+        dd_linestr_callback(aTHX_ "rv2cv", gvname);
       }
     }
     return o;
   }
 #endif /* DD_CONST_VIA_RV2CV */
 
-  dd_linestr_callback(aTHX_ "rv2cv", GvNAME(kGVOP_gv));
+  dd_linestr_callback(aTHX_ "rv2cv", gvname);
 
   return o;
 }