diff options
| author | Brian Fraser <fraserbn@gmail.com> | 2011-07-05 03:26:09 -0300 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-06 13:00:58 -0700 |
| commit | d21989edd792d90d0833257821df6bf9f2ef8e76 (patch) | |
| tree | 9b1d36df0627592edcfcf66c724e6154adab64db /ext | |
| parent | b017083ab8aa5210fe7dd9b6b490c08e03f6cf8a (diff) | |
| download | perl-d21989edd792d90d0833257821df6bf9f2ef8e76.tar.gz | |
gv.c: Added gv_fetchmeth_(sv|pv|pvn)_autoload.
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 28 | ||||
| -rw-r--r-- | ext/XS-APItest/t/gv_fetchmeth_autoload.t | 47 |
2 files changed, 75 insertions, 0 deletions
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 56c9dd92d5..a71e61d7fb 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1897,6 +1897,34 @@ gv_fetchmeth_type(stash, methname, type, level, flags) XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef ); void +gv_fetchmeth_autoload_type(stash, methname, type, level, flags) + HV* stash + SV* methname + int type + I32 level + I32 flags + PREINIT: + STRLEN len; + const char * const name = SvPV_const(methname, len); + GV* gv; + PPCODE: + switch (type) { + case 0: + gv = gv_fetchmeth_autoload(stash, name, len, level); + break; + case 1: + gv = gv_fetchmeth_sv_autoload(stash, methname, level, flags); + break; + case 2: + gv = gv_fetchmeth_pv_autoload(stash, name, level, flags | SvUTF8(methname)); + break; + case 3: + gv = gv_fetchmeth_pvn_autoload(stash, name, len, level, flags | SvUTF8(methname)); + break; + } + XPUSHs( gv ? MUTABLE_SV(gv) : &PL_sv_undef ); + +void eval_sv(sv, flags) SV* sv I32 flags diff --git a/ext/XS-APItest/t/gv_fetchmeth_autoload.t b/ext/XS-APItest/t/gv_fetchmeth_autoload.t new file mode 100644 index 0000000000..e27059f519 --- /dev/null +++ b/ext/XS-APItest/t/gv_fetchmeth_autoload.t @@ -0,0 +1,47 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 35; + +use_ok('XS::APItest'); + +my $level = -1; +my @types = map { 'gv_fetchmeth' . $_ . "_autoload" } '', qw( _sv _pv _pvn ); + +sub test { "Sanity check" } + +for my $type ( 0..3 ) { + is *{XS::APItest::gv_fetchmeth_autoload_type(\%::, "test", 1, $level, 0)}{CODE}->(), "Sanity check"; +} + +{ + ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "etc", 1, $level, 0), "fails when the glob doesn't exist and AUTOLOAD is undefined,"; + local *AUTOLOAD = sub { 1 }; + is XS::APItest::gv_fetchmeth_autoload_type(\%::, "etc", 1, $level, 0), "*main::etc", "..but defining AUTOLOAD makes it succeed."; +} + +for my $type ( 0..3 ) { + my $meth = "gen$type"; + ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth, $type, -1, 0), "With level = -1, $types[$type] returns false."; + ok !$::{$meth}, "...and doesn't vivify the glob."; + + ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth, $type, 0, 0), "With level = 0, $types[$type] still returns false."; + ok $::{$meth}, "...but does vivify the glob."; + + ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth . $type, $type, $level, 0), "$types[$type] fails when the glob doesn't exist and AUTOLOAD is undefined,"; + local *AUTOLOAD = sub { 1 }; + is XS::APItest::gv_fetchmeth_autoload_type(\%::, $meth . $type, $type, $level, 0), "*main::$meth$type", "..but defining AUTOLOAD makes it succeed."; +} + +{ + no warnings 'once'; + *method = sub { 1 }; +} + +ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 0, $level, 0), "gv_fetchmeth() is nul-clean"; +ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 1, $level, 0), "gv_fetchmeth_autoload_sv() is nul-clean"; +is XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 2, $level, 0), "*main::method", "gv_fetchmeth_autoload_pv() is not nul-clean"; +ok !XS::APItest::gv_fetchmeth_autoload_type(\%::, "method\0not quite!", 3, $level, 0), "gv_fetchmeth_autoload_pvn() is nul-clean"; + |