Test cv_name

diff --git a/MANIFEST b/MANIFEST
index eb29a94..34573fd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3794,6 +3794,7 @@ ext/XS-APItest/t/coplabel.t       test cop_*_label
 ext/XS-APItest/t/copstash.t    test alloccopstash
 ext/XS-APItest/t/copyhints.t   test hv_copy_hints_hv() API
 ext/XS-APItest/t/customop.t    XS::APItest: tests for custom ops
+ext/XS-APItest/t/cv_name.t     test cv_name
 ext/XS-APItest/t/eval-filter.t Simple source filter/eval test
 ext/XS-APItest/t/exception.t   XS::APItest extension
 ext/XS-APItest/t/fetch_pad_names.t     Tests for UTF8 names in pad

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 54ee2da..777e342 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3589,6 +3589,13 @@ alias_av(AV *av, IV ix, SV *sv)
     CODE:
        av_store(av, ix, SvREFCNT_inc(sv));
 
+SV *
+cv_name(SVREF ref, ...)
+    CODE:
+       RETVAL = SvREFCNT_inc(cv_name((CV *)ref, items>1 ? ST(1) : NULL));
+    OUTPUT:
+       RETVAL
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int

diff --git a/ext/XS-APItest/t/cv_name.t b/ext/XS-APItest/t/cv_name.t
new file mode 100644 (file)
index 0000000..cc6202a
--- /dev/null
+++ b/ext/XS-APItest/t/cv_name.t
@@ -0,0 +1,29 @@
+use XS::APItest;
+use Test::More tests => 15;
+use feature "lexical_subs", "state";
+no warnings "experimental::lexical_subs";
+
+is (cv_name(\&foo), 'main::foo', 'cv_name with package sub');
+is (cv_name(*{"foo"}{CODE}), 'main::foo',
+   'cv_name with package sub via glob');
+is (cv_name(\*{"foo"}), 'main::foo', 'cv_name with typeglob');
+is (cv_name(\"foo"), 'foo', 'cv_name with string');
+state sub lex1;
+is (cv_name(\&lex1), 'lex1', 'cv_name with lexical sub');
+
+$ret = \cv_name(\&bar, $name);
+is $ret, \$name, 'cv_name with package sub returns 2nd argument';
+is ($name, 'main::bar', 'retval of cv_name with package sub & 2nd arg');
+$ret = \cv_name(*{"bar"}{CODE}, $name);
+is $ret, \$name, 'cv_name with package sub via glob returns 2nd argument';
+is ($name, 'main::bar', 'retval of cv_name w/pkg sub via glob & 2nd arg');
+$ret = \cv_name(\*{"bar"}, $name);
+is $ret, \$name, 'cv_name with typeglob returns 2nd argument';
+is ($name, 'main::bar', 'retval of cv_name with typeglob & 2nd arg');
+$ret = \cv_name(\"bar", $name);
+is $ret, \$name, 'cv_name with string returns 2nd argument';
+is ($name, 'bar', 'retval of cv_name with string & 2nd arg');
+state sub lex2;
+$ret = \cv_name(\&lex2, $name);
+is $ret, \$name, 'cv_name with lexical sub returns 2nd argument';
+is ($name, 'lex2', 'retval of cv_name with lexical sub & 2nd arg');