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