This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Basic tests for get_cvn_flags
authorFather Chrysostomos <sprout@cpan.org>
Tue, 31 Oct 2017 04:49:04 +0000 (21:49 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 31 Oct 2017 21:54:52 +0000 (14:54 -0700)
MANIFEST
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/get.t [new file with mode: 0644]

index e71a13a..cfa1ecd 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4295,6 +4295,7 @@ 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/extend.t      test EXTEND() macro
 ext/XS-APItest/t/fetch_pad_names.t     Tests for UTF8 names in pad
+ext/XS-APItest/t/get.t         test get_sv et al.
 ext/XS-APItest/t/gotosub.t     XS::APItest: tests goto &xsub and hints
 ext/XS-APItest/t/grok.t                XS::APItest: tests for grok* functions
 ext/XS-APItest/t/gv_autoload4.t        XS::APItest: tests for gv_autoload4() and variants
index 9eafb0a..e66f8f4 100644 (file)
@@ -4277,6 +4277,17 @@ string_without_null(SV *sv)
     OUTPUT:
         RETVAL
 
+CV *
+get_cv(SV *sv)
+    CODE:
+    {
+        STRLEN len;
+        const char *s = SvPV(sv, len);
+        RETVAL = get_cvn_flags(s, len, 0);
+    }
+    OUTPUT:
+        RETVAL
+
 MODULE = XS::APItest PACKAGE = XS::APItest::AUTOLOADtest
 
 int
diff --git a/ext/XS-APItest/t/get.t b/ext/XS-APItest/t/get.t
new file mode 100644 (file)
index 0000000..59e2bfc
--- /dev/null
@@ -0,0 +1,17 @@
+
+# Tests for the get_*v functions.
+
+use Test::More tests => 3;
+use XS::APItest;
+
+# XXX So far we only test get_cv.
+
+is get_cv("utf8::encode"), \&utf8::encode, 'get_cv(utf8::encode)';
+
+sub foo { " ooof" } # should be stored in the stash as a subref
+die "Test has been sabotaged: sub foo{} should not create a full glob"
+    unless ref $::{foo} eq 'CODE';
+
+my $subref = get_cv("foo");
+is ref $subref, "CODE", 'got a coderef from get_cv("globless sub")';
+is &$subref, " ooof", 'got the right sub';