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