core/alien/alien-tests.factor

   1 USING: accessors alien alien.accessors alien.syntax byte-arrays arrays
   2 kernel kernel.private namespaces tools.test sequences libc math
   3 system prettyprint layouts alien.libraries sets ;
   4 FROM: namespaces => set ;
   5 IN: alien.tests
   6
   7 [ t ] [ -1 <alien> alien-address 0 > ] unit-test
   8
   9 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
  10 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
  11 [ f ] [ "hello" 1024 <alien> = ] unit-test
  12 [ f ] [ 0 <alien> ] unit-test
  13 [ f ] [ 0 f <displaced-alien> ] unit-test
  14
  15 ! Testing the various bignum accessor
  16 10 <byte-array> "dump" set
  17
  18 [ "dump" get alien-address ] must-fail
  19
  20 [ 123 ] [
  21     123 "dump" get 0 set-alien-signed-1
  22     "dump" get 0 alien-signed-1
  23 ] unit-test
  24
  25 [ 12345 ] [
  26     12345 "dump" get 0 set-alien-signed-2
  27     "dump" get 0 alien-signed-2
  28 ] unit-test
  29
  30 [ 12345678 ] [
  31     12345678 "dump" get 0 set-alien-signed-4
  32     "dump" get 0 alien-signed-4
  33 ] unit-test
  34
  35 [ 12345678901234567 ] [
  36     12345678901234567 "dump" get 0 set-alien-signed-8
  37     "dump" get 0 alien-signed-8
  38 ] unit-test
  39
  40 [ -1 ] [
  41     -1 "dump" get 0 set-alien-signed-8
  42     "dump" get 0 alien-signed-8
  43 ] unit-test
  44
  45 cell 8 = [
  46     [ 0x123412341234 ] [
  47       8 <byte-array>
  48       0x123412341234 over 0 set-alien-signed-8
  49       0 alien-signed-8
  50     ] unit-test
  51
  52     [ 0x123412341234 ] [
  53       8 <byte-array>
  54       0x123412341234 over 0 set-alien-signed-cell
  55       0 alien-signed-cell
  56     ] unit-test
  57 ] when
  58
  59 [ "ALIEN: 1234" ] [ 0x1234 <alien> unparse ] unit-test
  60
  61 [ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
  62
  63 [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] must-fail
  64
  65 [ 1 1 <displaced-alien> ] must-fail
  66
  67 [ f ] [ 1 B{ 1 2 3 } <displaced-alien> pinned-c-ptr? ] unit-test
  68
  69 [ f ] [ 2 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> pinned-c-ptr? ] unit-test
  70
  71 [ t ] [ 0 B{ 1 2 3 } <displaced-alien> 1 swap <displaced-alien> underlying>> byte-array? ] unit-test
  72
  73 [ "( displaced alien )" ] [ 1 B{ 1 2 3 } <displaced-alien> unparse ] unit-test
  74
  75 SYMBOL: initialize-test
  76
  77 f initialize-test set-global
  78
  79 [ 31337 ] [ initialize-test [ 31337 ] initialize-alien ] unit-test
  80
  81 [ 31337 ] [ initialize-test [ 69 ] initialize-alien ] unit-test
  82
  83 [ ] [ initialize-test get BAD-ALIEN >>alien drop ] unit-test
  84
  85 [ 7575 ] [ initialize-test [ 7575 ] initialize-alien ] unit-test
  86
  87 [ { BAD-ALIEN } ] [ { BAD-ALIEN BAD-ALIEN BAD-ALIEN } members ] unit-test