diff options
Diffstat (limited to 'ext')
-rw-r--r-- | ext/XS-APItest/APItest.xs | 41 | ||||
-rw-r--r-- | ext/XS-APItest/t/ptr_table.t | 45 | ||||
-rw-r--r-- | ext/XS-APItest/typemap | 1 |
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 |