basis/specialized-arrays/specialized-arrays-tests.factor

   1 IN: specialized-arrays.tests
   2 USING: tools.test alien.syntax specialized-arrays
   3 specialized-arrays.private sequences alien.c-types accessors
   4 kernel arrays combinators compiler compiler.units classes.struct
   5 combinators.smart compiler.tree.debugger math libc destructors
   6 sequences.private multiline eval words vocabs namespaces
   7 assocs prettyprint alien.data math.vectors ;
   8 FROM: alien.c-types => float ;
   9
  10 SPECIALIZED-ARRAY: int
  11 SPECIALIZED-ARRAY: bool
  12 SPECIALIZED-ARRAY: ushort
  13 SPECIALIZED-ARRAY: char
  14 SPECIALIZED-ARRAY: uint
  15 SPECIALIZED-ARRAY: float
  16 SPECIALIZED-ARRAY: ulonglong
  17
  18 [ ulonglong ] [ ulonglong-array{ } element-type ] unit-test
  19
  20 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
  21
  22 [ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
  23
  24 [ 2 ] [ int-array{ 1 2 3 } second ] unit-test
  25
  26 [ t ] [
  27     { t f t } >bool-array underlying>>
  28     { 1 0 1 } "bool" heap-size {
  29         { 1 [ >char-array ] }
  30         { 4 [ >uint-array ] }
  31     } case underlying>> =
  32 ] unit-test
  33
  34 [ ushort-array{ 1234 } ] [
  35     little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array
  36 ] unit-test
  37
  38 [ B{ 210 4 1 } byte-array>ushort-array ] must-fail
  39
  40 [ { 3 1 3 3 7 } ] [
  41     int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
  42 ] unit-test
  43
  44 [ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
  45
  46 [ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
  47
  48 [ ushort-array{ 0 0 0 } ] [
  49     3 ALIEN: 123 100 <direct-ushort-array> new-sequence
  50     dup [ drop 0 ] change-each
  51 ] unit-test
  52
  53 STRUCT: test-struct
  54     { x int }
  55     { y int } ;
  56
  57 SPECIALIZED-ARRAY: test-struct
  58
  59 [ 1 ] [
  60     1 test-struct-array{ } new-sequence length
  61 ] unit-test
  62
  63 [ V{ test-struct } ] [
  64     [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
  65 ] unit-test
  66
  67 : make-point ( x y -- struct )
  68     test-struct <struct-boa> ;
  69
  70 [ 5/4 ] [
  71     2 <test-struct-array>
  72     1 2 make-point over set-first
  73     3 4 make-point over set-second
  74     0 [ [ x>> ] [ y>> ] bi / + ] reduce
  75 ] unit-test
  76
  77 [ 5/4 ] [
  78     [
  79         2 malloc-test-struct-array
  80         dup &free drop
  81         1 2 make-point over set-first
  82         3 4 make-point over set-second
  83         0 [ [ x>> ] [ y>> ] bi / + ] reduce
  84     ] with-destructors
  85 ] unit-test
  86
  87 [ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
  88
  89 [ ] [
  90     [
  91         10 malloc-test-struct-array
  92         &free drop
  93     ] with-destructors
  94 ] unit-test
  95
  96 [ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
  97
  98 [ S{ test-struct f 12 20 } ] [
  99     test-struct-array{
 100         S{ test-struct f  4 20 }
 101         S{ test-struct f 12 20 }
 102         S{ test-struct f 20 20 }
 103     } second
 104 ] unit-test
 105
 106 ! Regression
 107 STRUCT: fixed-string { text char[64] } ;
 108
 109 SPECIALIZED-ARRAY: fixed-string
 110
 111 [ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } ] [
 112     ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
 113 ] unit-test
 114
 115 ! Ensure that byte-length works with direct arrays
 116 [ 400 ] [
 117     ALIEN: 123 100 <direct-int-array> byte-length
 118 ] unit-test
 119
 120 ! Test prettyprinting
 121 [ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
 122 [ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
 123
 124 ! If the C type doesn't exist, don't generate a vocab
 125 [ ] [
 126     [ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit
 127     "__does_not_exist__" c-types get delete-at
 128 ] unit-test
 129
 130 [
 131     <"
 132 IN: specialized-arrays.tests
 133 USING: specialized-arrays ;
 134
 135 SPECIALIZED-ARRAY: __does_not_exist__ "> eval( -- )
 136 ] must-fail
 137
 138 [ ] [
 139     <"
 140 IN: specialized-arrays.tests
 141 USING: classes.struct specialized-arrays ;
 142
 143 STRUCT: __does_not_exist__ { x int } ;
 144
 145 SPECIALIZED-ARRAY: __does_not_exist__
 146 "> eval( -- )
 147 ] unit-test
 148
 149 [ f ] [
 150     "__does_not_exist__-array{"
 151     "__does_not_exist__" specialized-array-vocab lookup
 152     deferred?
 153 ] unit-test