From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 29 Apr 2010 14:27:31 +0000 (+0100)
Subject: Regression tests for the ptr_table_* API.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=36c2b1d054d816a24315524ae15e6e339a59c766;p=p5sagit%2Fp5-mst-13.2.git

Regression tests for the ptr_table_* API.
---

diff --git a/MANIFEST b/MANIFEST
index 436d921..f3827c8 100644
--- 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
--- 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 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
index 0000000..035f882
--- /dev/null
+++ b/ext/XS-APItest/typemap
@@ -0,0 +1 @@
+XS::APItest::PtrTable		T_PTROBJ