Regression tests for the ptr_table_* API.

diff --git a/MANIFEST b/MANIFEST
index 436d921..f3827c8 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3226,6 +3226,7 @@ ext/XS-APItest/t/my_exit.t        XS::APItest: test my_exit
 ext/XS-APItest/t/op.t          XS::APItest: tests for OP related APIs
 ext/XS-APItest/t/pmflag.t      Test removal of Perl_pmflag()
 ext/XS-APItest/t/printf.t      XS::APItest extension
+ext/XS-APItest/t/ptr_table.t   Test ptr_table_* APIs
 ext/XS-APItest/t/push.t                XS::APItest extension
 ext/XS-APItest/t/rmagical.t    XS::APItest extension
 ext/XS-APItest/t/svpeek.t      XS::APItest extension
@@ -3233,6 +3234,7 @@ ext/XS-APItest/t/svsetsv.t        Test behaviour of sv_setsv with/without PERL_CORE
 ext/XS-APItest/t/utf16_to_utf8.t       Test behaviour of utf16_to_utf8{,reversed}
 ext/XS-APItest/t/xs_special_subs_require.t     for require too
 ext/XS-APItest/t/xs_special_subs.t     Test that XS BEGIN/CHECK/INIT/END work
+ext/XS-APItest/typemap
 ext/XS-Typemap/Makefile.PL     XS::Typemap extension
 ext/XS-Typemap/README          XS::Typemap extension
 ext/XS-Typemap/stdio.c         XS::Typemap extension

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index ee57c83..1a80d59 100644 (file)
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -3,6 +3,8 @@
 #include "perl.h"
 #include "XSUB.h"
 
+typedef SV *SVREF;
+typedef PTR_TBL_t *XS__APItest__PtrTable;
 
 /* for my_cxt tests */
 
@@ -547,6 +549,45 @@ sub CLEAR    { %{$_[0]} = () }
 
 =cut
 
+MODULE = XS::APItest::PtrTable PACKAGE = XS::APItest::PtrTable PREFIX = ptr_table_
+
+void
+ptr_table_new(classname)
+const char * classname
+    PPCODE:
+    PUSHs(sv_setref_pv(sv_newmortal(), classname, (void*)ptr_table_new()));
+
+void
+DESTROY(table)
+XS::APItest::PtrTable table
+    CODE:
+    ptr_table_free(table);
+
+void
+ptr_table_store(table, old, new)
+XS::APItest::PtrTable table
+SVREF old
+SVREF new
+   CODE:
+   ptr_table_store(table, old, new);
+
+UV
+ptr_table_fetch(table, old)
+XS::APItest::PtrTable table
+SVREF old
+   CODE:
+   RETVAL = PTR2UV(ptr_table_fetch(table, old));
+   OUTPUT:
+   RETVAL
+
+void
+ptr_table_split(table)
+XS::APItest::PtrTable table
+
+void
+ptr_table_clear(table)
+XS::APItest::PtrTable table
+
 MODULE = XS::APItest           PACKAGE = XS::APItest
 
 PROTOTYPES: DISABLE

diff --git a/ext/XS-APItest/t/ptr_table.t b/ext/XS-APItest/t/ptr_table.t
new file mode 100644 (file)
index 0000000..c7e9a57
--- /dev/null
+++ b/ext/XS-APItest/t/ptr_table.t
@@ -0,0 +1,45 @@
+#!perl -w
+use strict;
+
+use XS::APItest;
+use Test::More;
+
+# Some addresses for testing.
+my $a = [];
+my $h = {};
+my $c = sub {};
+
+my $t1 = XS::APItest::PtrTable->new();
+isa_ok($t1, 'XS::APItest::PtrTable');
+my $t2 = XS::APItest::PtrTable->new();
+isa_ok($t2, 'XS::APItest::PtrTable');
+cmp_ok($t1, '!=', $t2, 'Not the same object');
+
+undef $t2;
+
+# Still here? :-)
+isa_ok($t1, 'XS::APItest::PtrTable');
+
+is($t1->fetch($a), 0, 'Not found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->store($a, $h);
+
+cmp_ok($t1->fetch($a), '==', $h, 'Found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->split();
+
+cmp_ok($t1->fetch($a), '==', $h, 'Found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+$t1->clear();
+
+is($t1->fetch($a), 0, 'Not found');
+is($t1->fetch($h), 0, 'Not found');
+is($t1->fetch($c), 0, 'Not found');
+
+done_testing();

diff --git a/ext/XS-APItest/typemap b/ext/XS-APItest/typemap
new file mode 100644 (file)
index 0000000..035f882
--- /dev/null
+++ b/ext/XS-APItest/typemap
@@ -0,0 +1 @@
+XS::APItest::PtrTable          T_PTROBJ