Tests for Perl_get_vtbl()

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index b9f4a67..3ddf8d1 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -2819,3 +2819,50 @@ ALIAS:
     sv_unmagic_bar = 1
 CODE:
     sv_unmagicext(SvRV(sv), PERL_MAGIC_ext, ix ? &vtbl_bar : &vtbl_foo);
+
+UV
+test_get_vtbl()
+    PREINIT:
+       MGVTBL *have;
+       MGVTBL *want;
+    CODE:
+#define test_get_this_vtable(name) \
+       want = CAT2(&PL_vtbl_, name); \
+       have = get_vtbl(CAT2(want_vtbl_, name)); \
+       if (have != want) \
+           croak("fail %p!=%p for get_vtbl(want_vtbl_" STRINGIFY(name) ") at " __FILE__ " line %d", have, want, __LINE__)
+
+       test_get_this_vtable(sv);
+       test_get_this_vtable(env);
+       test_get_this_vtable(envelem);
+       test_get_this_vtable(sigelem);
+       test_get_this_vtable(pack);
+       test_get_this_vtable(packelem);
+       test_get_this_vtable(dbline);
+       test_get_this_vtable(isa);
+       test_get_this_vtable(isaelem);
+       test_get_this_vtable(arylen);
+       test_get_this_vtable(mglob);
+       test_get_this_vtable(nkeys);
+       test_get_this_vtable(taint);
+       test_get_this_vtable(substr);
+       test_get_this_vtable(vec);
+       test_get_this_vtable(pos);
+       test_get_this_vtable(bm);
+       test_get_this_vtable(fm);
+       test_get_this_vtable(uvar);
+       test_get_this_vtable(defelem);
+       test_get_this_vtable(regexp);
+       test_get_this_vtable(regdata);
+       test_get_this_vtable(regdatum);
+#ifdef USE_LOCALE_COLLATE
+       test_get_this_vtable(collxfrm);
+#endif
+       test_get_this_vtable(amagic);
+       test_get_this_vtable(amagicelem);
+       test_get_this_vtable(backref);
+       test_get_this_vtable(utf8);
+
+       RETVAL = PTR2UV(get_vtbl(-1));
+    OUTPUT:
+       RETVAL

diff --git a/ext/XS-APItest/t/magic.t b/ext/XS-APItest/t/magic.t
index 9dfb7c1..8451f01 100644 (file)
--- a/ext/XS-APItest/t/magic.t
+++ b/ext/XS-APItest/t/magic.t
@@ -27,4 +27,6 @@ sv_unmagic_bar($sv);
 ok !mg_find_foo($sv), 'foo magic still removed';
 ok !mg_find_bar($sv), '... and bar magic is removed too';
 
+is(test_get_vtbl(), 0, 'get_vtbl(-1) returns NULL');
+
 done_testing;