diff options
| author | Brian Fraser <fraserbn@gmail.com> | 2011-06-11 15:38:11 -0300 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-07-12 21:46:53 -0700 |
| commit | ab8f91e928bd083c5c24dda5ab81ff3707aef750 (patch) | |
| tree | c239e3572daea9d1697f14d2dd52d8f635ea855a /ext/XS-APItest | |
| parent | e8b344872c07b783a56ffa52360e75a5c16dcb5e (diff) | |
| download | perl-ab8f91e928bd083c5c24dda5ab81ff3707aef750.tar.gz | |
Tests for the pad cleanup.
Diffstat (limited to 'ext/XS-APItest')
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 25 | ||||
| -rw-r--r-- | ext/XS-APItest/t/fetch_pad_names.t | 4 |
2 files changed, 25 insertions, 4 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 14415aad47..3aadc3dcfe 100644 --- 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 384ca36904..8d6e73969e 100644 --- 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' }, |