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

   1 IN: specialized-arrays.tests
   2 USING: tools.test alien.syntax specialized-arrays
   3 specialized-arrays sequences alien.c-types accessors
   4 kernel arrays combinators compiler classes.struct
   5 combinators.smart compiler.tree.debugger math libc destructors
   6 sequences.private ;
   7
   8 SPECIALIZED-ARRAY: int
   9 SPECIALIZED-ARRAY: bool
  10 SPECIALIZED-ARRAY: ushort
  11 SPECIALIZED-ARRAY: char
  12 SPECIALIZED-ARRAY: uint
  13 SPECIALIZED-ARRAY: float
  14
  15 [ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
  16
  17 [ t ] [ int-array{ 1 2 3 } int-array? ] unit-test
  18
  19 [ 2 ] [ int-array{ 1 2 3 } second ] unit-test
  20
  21 [ t ] [
  22     { t f t } >bool-array underlying>>
  23     { 1 0 1 } "bool" heap-size {
  24         { 1 [ >char-array ] }
  25         { 4 [ >uint-array ] }
  26     } case underlying>> =
  27 ] unit-test
  28
  29 [ ushort-array{ 1234 } ] [
  30     little-endian? B{ 210 4 } B{ 4 210 } ? byte-array>ushort-array
  31 ] unit-test
  32
  33 [ B{ 210 4 1 } byte-array>ushort-array ] must-fail
  34
  35 [ { 3 1 3 3 7 } ] [
  36     int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
  37 ] unit-test
  38
  39 [ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
  40
  41 [ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
  42
  43 [ ushort-array{ 0 0 0 } ] [
  44     3 ALIEN: 123 100 <direct-ushort-array> new-sequence
  45     dup [ drop 0 ] change-each
  46 ] unit-test
  47
  48 STRUCT: test-struct
  49     { x int }
  50     { y int } ;
  51
  52 SPECIALIZED-ARRAY: test-struct
  53
  54 [ 1 ] [
  55     1 test-struct-array{ } new-sequence length
  56 ] unit-test
  57
  58 [ V{ test-struct } ] [
  59     [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
  60 ] unit-test
  61
  62 : make-point ( x y -- struct )
  63     test-struct <struct-boa> ;
  64
  65 [ 5/4 ] [
  66     2 <test-struct-array>
  67     1 2 make-point over set-first
  68     3 4 make-point over set-second
  69     0 [ [ x>> ] [ y>> ] bi / + ] reduce
  70 ] unit-test
  71
  72 [ 5/4 ] [
  73     [
  74         2 malloc-test-struct-array
  75         dup &free drop
  76         1 2 make-point over set-first
  77         3 4 make-point over set-second
  78         0 [ [ x>> ] [ y>> ] bi / + ] reduce
  79     ] with-destructors
  80 ] unit-test
  81
  82 [ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
  83
  84 [ ] [
  85     [
  86         10 malloc-test-struct-array
  87         &free drop
  88     ] with-destructors
  89 ] unit-test
  90
  91 [ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
  92
  93 [ S{ test-struct f 12 20 } ] [
  94     test-struct-array{
  95         S{ test-struct f  4 20 }
  96         S{ test-struct f 12 20 }
  97         S{ test-struct f 20 20 }
  98     } second
  99 ] unit-test
 100
 101 ! Regression
 102 STRUCT: fixed-string { text char[100] } ;
 103
 104 SPECIALIZED-ARRAY: fixed-string
 105
 106 [ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
 107     ALIEN: 123 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
 108 ] unit-test