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