Regression tests for the ptr_table_* API.

3 files changed, 87 insertions, 0 deletions

diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index ee57c8311f..1a80d598e7 100644
--- 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
index 0000000000..c7e9a57cf1
--- /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
index 0000000000..035f882a6b
--- /dev/null
+++ b/ext/XS-APItest/typemap
@@ -0,0 +1 @@
+XS::APItest::PtrTable		T_PTROBJ