basis/struct-arrays/struct-arrays-tests.factor

   1 IN: struct-arrays.tests
   2 USING: classes.struct struct-arrays tools.test kernel math sequences
   3 alien.syntax alien.c-types destructors libc accessors sequences.private
   4 compiler.tree.debugger combinators.smart ;
   5
   6 STRUCT: test-struct-array
   7     { x int }
   8     { y int } ;
   9
  10 [ 1 ] [
  11     1 struct-array{ test-struct-array } new-sequence length
  12 ] unit-test
  13
  14 [ V{ test-struct-array } ] [
  15     [ [ test-struct-array <struct> ] struct-array{ test-struct-array } output>sequence first ] final-classes
  16 ] unit-test
  17
  18 : make-point ( x y -- struct )
  19     test-struct-array <struct-boa> ;
  20
  21 [ 5/4 ] [
  22     2 test-struct-array <struct-array>
  23     1 2 make-point over set-first
  24     3 4 make-point over set-second
  25     0 [ [ x>> ] [ y>> ] bi / + ] reduce
  26 ] unit-test
  27
  28 [ 5/4 ] [
  29     [
  30         2 test-struct-array malloc-struct-array
  31         dup &free drop
  32         1 2 make-point over set-first
  33         3 4 make-point over set-second
  34         0 [ [ x>> ] [ y>> ] bi / + ] reduce
  35     ] with-destructors
  36 ] unit-test
  37
  38 [ ] [ ALIEN: 123 10 test-struct-array <direct-struct-array> drop ] unit-test
  39
  40 [ ] [
  41     [
  42         10 test-struct-array malloc-struct-array
  43         &free drop
  44     ] with-destructors
  45 ] unit-test
  46
  47 [ 15 ] [ 15 10 test-struct-array <struct-array> resize length ] unit-test
  48
  49 [ S{ test-struct-array f 12 20 } ] [
  50     struct-array{ test-struct-array
  51         S{ test-struct-array f  4 20 }
  52         S{ test-struct-array f 12 20 }
  53         S{ test-struct-array f 20 20 }
  54     } second
  55 ] unit-test
  56
  57 ! Regression
  58 STRUCT: fixed-string { text char[100] } ;
  59
  60 [ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
  61     ALIEN: 123 4 fixed-string <direct-struct-array> [ (underlying)>> ] { } map-as
  62 ] unit-test
  63
  64 [ 10 "int" <struct-array> ] must-fail
  65
  66 STRUCT: wig { x int } ;
  67 : <bacon> ( -- wig ) 0 wig <struct-boa> ; inline
  68 : waterfall ( -- a b ) 1 wig <struct-array> <bacon> swap first x>> ; inline
  69
  70 [ t ] [ [ waterfall ] { x>> } inlined? ] unit-test