Tests for the pad cleanup.

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 14415aa..3aadc3d 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -613,14 +613,14 @@ THX_ck_entersub_pad_scalar(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
            SV *namesv = sv_2mortal(newSVpvs("$"));
            sv_catsv(namesv, a1);
            namepv = SvPV(namesv, namelen);
-           padoff = pad_findmy_pvn(namepv, namelen, 0);
+           padoff = pad_findmy_pvn(namepv, namelen, SvUTF8(namesv));
        } break;
        case 3: {
            char *namepv;
            SV *namesv = sv_2mortal(newSVpvs("$"));
            sv_catsv(namesv, a1);
            namepv = SvPV_nolen(namesv);
-           padoff = pad_findmy_pv(namepv, 0);
+           padoff = pad_findmy_pv(namepv, SvUTF8(namesv));
        } break;
        case 4: {
            padoff = pad_findmy_pvs("$foo", 0);
@@ -2926,6 +2926,27 @@ BOOT:
     cv_set_call_checker(pscv, THX_ck_entersub_pad_scalar, (SV*)pscv);
 }
 
+SV*
+fetch_pad_names( cv )
+CV* cv
+ PREINIT:
+  I32 i;
+  AV *pad_namelist;
+  AV *retav = newAV();
+ CODE:
+  pad_namelist = (AV*) *av_fetch(CvPADLIST(cv), 0, FALSE);
+
+  for ( i = av_len(pad_namelist); i >= 0; i-- ) {
+    SV** name_ptr = av_fetch(pad_namelist, i, 0);
+
+    if (name_ptr && SvPOKp(*name_ptr)) {
+        av_push(retav, newSVsv(*name_ptr));
+    }
+  }
+  RETVAL = newRV_noinc((SV*)retav);
+ OUTPUT:
+  RETVAL
+
 STRLEN
 underscore_length()
 PROTOTYPE:

diff --git a/ext/XS-APItest/t/fetch_pad_names.t b/ext/XS-APItest/t/fetch_pad_names.t
index 384ca36..8d6e739 100644 (file)
--- a/ext/XS-APItest/t/fetch_pad_names.t
+++ b/ext/XS-APItest/t/fetch_pad_names.t
@@ -41,8 +41,8 @@ general_tests( $cv->(), $names_av, {
                ],
     pad_size => {
                     total     => { cmp => 2, msg => 'Sub has two lexicals.' },
-                    utf8      => { cmp => 0, msg => '' },
-                    invariant => { cmp => 2, msg => '' },
+                    utf8      => { cmp => 0, msg => 'Sub has no UTF-8 encoded vars.' },
+                    invariant => { cmp => 2, msg => 'Sub has two invariant vars.' },
                 },
     vars    => [
                 { name => '$zest', msg => 'Sub has [\$zest].', type => 'ok' },