extra/alien/handles/handles-tests.factor

   1 ! (c)2010 Joe Groff bsd license
   2 USING: accessors alien alien.c-types alien.handles alien.syntax
   3 destructors kernel math tools.test ;
   4 IN: alien.handles.tests
   5
   6 TUPLE: thingy { x integer } ;
   7 C: <thingy> thingy
   8
   9 CALLBACK: int thingy-callback ( uint thingy-handle )
  10 CALLBACK: int thingy-ptr-callback ( void* thingy-handle )
  11
  12 : test-thingy-callback ( -- alien )
  13     [ alien-handle> x>> 1 + ] thingy-callback ;
  14
  15 : test-thingy-ptr-callback ( -- alien )
  16     [ alien-handle-ptr> x>> 1 + ] thingy-ptr-callback ;
  17
  18 : invoke-test-thingy-callback ( thingy -- n )
  19     test-thingy-callback int { uint } cdecl alien-indirect ;
  20 : invoke-test-thingy-ptr-callback ( thingy -- n )
  21     test-thingy-ptr-callback int { void* } cdecl alien-indirect ;
  22
  23 { t f } [
  24     [ 5 <thingy> <alien-handle> &release-alien-handle [ alien-handle? ] keep ] with-destructors
  25     alien-handle?
  26 ] unit-test
  27
  28 { t f } [
  29     [ 5 <thingy> <alien-handle-ptr> &release-alien-handle-ptr [ alien-handle-ptr? ] keep ] with-destructors
  30     alien-handle-ptr?
  31 ] unit-test
  32
  33 { 6 } [
  34     [
  35         5 <thingy> <alien-handle> &release-alien-handle
  36         invoke-test-thingy-callback
  37     ] with-destructors
  38 ] unit-test
  39
  40 { 6 } [
  41     [
  42         5 <thingy> <alien-handle-ptr> &release-alien-handle-ptr
  43         invoke-test-thingy-ptr-callback
  44     ] with-destructors
  45 ] unit-test