basis/math/vectors/simd/simd-tests.factor

   1 USING: accessors arrays classes compiler compiler.tree.debugger
   2 effects fry io kernel kernel.private math math.functions
   3 math.private math.vectors math.vectors.simd
   4 math.vectors.simd.private prettyprint random sequences system
   5 tools.test vocabs assocs compiler.cfg.debugger words
   6 locals math.vectors.specialization combinators cpu.architecture
   7 math.vectors.conversion.backend
   8 math.vectors.simd.intrinsics namespaces byte-arrays alien
   9 specialized-arrays classes.struct eval classes.algebra sets
  10 quotations math.constants compiler.units ;
  11 QUALIFIED-WITH: alien.c-types c
  12 SPECIALIZED-ARRAY: c:float
  13 SIMD: c:char
  14 SIMD: c:uchar
  15 SIMD: c:short
  16 SIMD: c:ushort
  17 SIMD: c:int
  18 SIMD: c:uint
  19 SIMD: c:longlong
  20 SIMD: c:ulonglong
  21 SIMD: c:float
  22 SIMD: c:double
  23 IN: math.vectors.simd.tests
  24
  25 ! Make sure the functor doesn't generate bogus vocabularies
  26 2 [ [ "USE: math.vectors.simd SIMD: rubinius" eval( -- ) ] must-fail ] times
  27
  28 [ f ] [ "math.vectors.simd.instances.rubinius" vocab ] unit-test
  29
  30 ! Test type propagation
  31 [ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
  32
  33 [ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
  34
  35 [ V{ float-4 } ] [ [ { float-4 } declare normalize ] final-classes ] unit-test
  36
  37 [ V{ float-4 } ] [ [ { float-4 float-4 } declare v+ ] final-classes ] unit-test
  38
  39 [ V{ float } ] [ [ { float-4 } declare second ] final-classes ] unit-test
  40
  41 [ V{ int-4 } ] [ [ { int-4 int-4 } declare v+ ] final-classes ] unit-test
  42
  43 [ t ] [ [ { int-4 } declare second ] final-classes first integer class<= ] unit-test
  44
  45 [ V{ longlong-2 } ] [ [ { longlong-2 longlong-2 } declare v+ ] final-classes ] unit-test
  46
  47 [ V{ integer } ] [ [ { longlong-2 } declare second ] final-classes ] unit-test
  48
  49 [ V{ int-8 } ] [ [ { int-8 int-8 } declare v+ ] final-classes ] unit-test
  50
  51 [ t ] [ [ { int-8 } declare second ] final-classes first integer class<= ] unit-test
  52
  53 ! Test puns; only on x86
  54 cpu x86? [
  55     [ double-2{ 4 1024 } ] [
  56         float-4{ 0 1 0 2 }
  57         [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
  58     ] unit-test
  59
  60     [ 33.0 ] [
  61         double-2{ 1 2 } double-2{ 10 20 }
  62         [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
  63     ] unit-test
  64 ] when
  65
  66 ! Fuzz testing
  67 CONSTANT: simd-classes
  68     {
  69         char-16
  70         uchar-16
  71         char-32
  72         uchar-32
  73         short-8
  74         ushort-8
  75         short-16
  76         ushort-16
  77         int-4
  78         uint-4
  79         int-8
  80         uint-8
  81         longlong-2
  82         ulonglong-2
  83         longlong-4
  84         ulonglong-4
  85         float-4
  86         float-8
  87         double-2
  88         double-4
  89     }
  90
  91 : with-ctors ( -- seq )
  92     simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ;
  93
  94 : boa-ctors ( -- seq )
  95     simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
  96
  97 : check-optimizer ( seq quot eq-quot -- failures )
  98     '[
  99         @
 100         [ dup [ class ] { } map-as ] dip '[ _ declare @ ]
 101         {
 102             [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
 103             [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
 104             [ [ call ] dip call ]
 105             [ [ call ] dip compile-call ]
 106         } 2cleave
 107         @ not
 108     ] filter ; inline
 109
 110 "== Checking -new constructors" print
 111
 112 [ { } ] [
 113     simd-classes [ [ [ ] ] dip '[ _ new ] ] [ = ] check-optimizer
 114 ] unit-test
 115
 116 [ { } ] [
 117     simd-classes [ '[ _ new ] compile-call [ zero? ] all? not ] filter
 118 ] unit-test
 119
 120 "== Checking -with constructors" print
 121
 122 [ { } ] [
 123     with-ctors [
 124         [ 1000 random '[ _ ] ] dip '[ _ execute ]
 125     ] [ = ] check-optimizer
 126 ] unit-test
 127
 128 [ HEX: ffffffff ] [ HEX: ffffffff uint-4-with first ] unit-test
 129
 130 [ HEX: ffffffff ] [ HEX: ffffffff [ uint-4-with ] compile-call first ] unit-test
 131
 132 "== Checking -boa constructors" print
 133
 134 [ { } ] [
 135     boa-ctors [
 136         [ stack-effect in>> length [ 1000 random ] [ ] replicate-as ] keep
 137         '[ _ execute ]
 138     ] [ = ] check-optimizer
 139 ] unit-test
 140
 141 [ HEX: ffffffff ] [ HEX: ffffffff 2 3 4 [ uint-4-boa ] compile-call first ] unit-test
 142
 143 "== Checking vector operations" print
 144
 145 : random-int-vector ( class -- vec )
 146     new [ drop 1,000 random ] map ;
 147 : random-float-vector ( class -- vec )
 148     new [
 149         drop
 150         1000 random
 151         10 swap <array> 0/0. suffix random
 152     ] map ;
 153
 154 : random-vector ( class elt-class -- vec )
 155     float =
 156     [ random-float-vector ]
 157     [ random-int-vector ] if ;
 158
 159 :: check-vector-op ( word inputs class elt-class -- inputs quot )
 160     inputs [
 161         {
 162             { +vector+ [ class elt-class random-vector ] }
 163             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 164         } case
 165     ] [ ] map-as
 166     word '[ _ execute ] ;
 167
 168 : remove-float-words ( alist -- alist' )
 169     { vsqrt n/v v/n v/ normalize } unique assoc-diff ;
 170
 171 : remove-integer-words ( alist -- alist' )
 172     { vlshift vrshift } unique assoc-diff ;
 173
 174 : boolean-ops ( -- words )
 175     { vand vandn vor vxor vnot } ;
 176
 177 : remove-boolean-words ( alist -- alist' )
 178     boolean-ops unique assoc-diff ;
 179
 180 : remove-special-words ( alist -- alist' )
 181     ! These have their own tests later
 182     {
 183         hlshift hrshift vshuffle vbroadcast
 184         vany? vall? vnone?
 185         (v>float) (v>integer)
 186         (vpack-signed) (vpack-unsigned)
 187         (vunpack-head) (vunpack-tail)
 188     } unique assoc-diff ;
 189
 190 : ops-to-check ( elt-class -- alist )
 191     [ vector-words >alist ] dip
 192     float = [ remove-integer-words ] [ remove-float-words ] if
 193     remove-boolean-words
 194     remove-special-words ;
 195
 196 : check-vector-ops ( class elt-class compare-quot -- )
 197     [
 198         [ nip ops-to-check ] 2keep
 199         '[ first2 inputs _ _ check-vector-op ]
 200     ] dip check-optimizer ; inline
 201
 202 : approx= ( x y -- ? )
 203     {
 204         { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
 205         { [ 2dup [ float? ] both? ] [ -1.e8 ~ ] }
 206         { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
 207         { [ 2dup [ sequence? ] both? ] [
 208             [
 209                 {
 210                     { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
 211                     { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
 212                     { [ 2dup [ fp-nan? ] either? not ] [ -1.e8 ~ ] }
 213                 } cond
 214             ] 2all?
 215         ] }
 216     } cond ;
 217
 218 : exact= ( x y -- ? )
 219     {
 220         { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
 221         { [ 2dup [ sequence? ] both? ] [ [ fp-bitwise= ] 2all? ] }
 222     } cond ;
 223
 224 : simd-classes&reps ( -- alist )
 225     simd-classes [
 226         {
 227             { [ dup name>> "float" head? ] [ float [ approx= ] ] }
 228             { [ dup name>> "double" head? ] [ float [ exact= ] ] }
 229             [ fixnum [ = ] ]
 230         } cond 3array
 231     ] map ;
 232
 233 simd-classes&reps [
 234     [ [ { } ] ] dip first3 '[ _ _ _ check-vector-ops ] unit-test
 235 ] each
 236
 237 "== Checking boolean operations" print
 238
 239 : random-boolean-vector ( class -- vec )
 240     new [ drop 2 random zero? ] map ;
 241
 242 :: check-boolean-op ( word inputs class elt-class -- inputs quot )
 243     inputs [
 244         {
 245             { +vector+ [ class random-boolean-vector ] }
 246             { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
 247         } case
 248     ] [ ] map-as
 249     word '[ _ execute ] ;
 250
 251 : check-boolean-ops ( class elt-class compare-quot -- )
 252     [
 253         [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
 254         '[ first2 inputs _ _ check-boolean-op ]
 255     ] dip check-optimizer ; inline
 256
 257 simd-classes&reps [
 258     [ [ { } ] ] dip first3 '[ _ _ _ check-boolean-ops ] unit-test
 259 ] each
 260
 261 "== Checking vector blend" print
 262
 263 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 264 [
 265     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 266     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 267     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 } v?
 268 ] unit-test
 269
 270 [ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
 271 [
 272     char-16{ t  t  f  f  t  t  t  f  t  f   f   f   t   f   t   t }
 273     char-16{ 0  1  2  3  4  5  6  7  8  9  10  11  12  13  14  15 }
 274     char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 }
 275     [ { char-16 char-16 char-16 } declare v? ] compile-call
 276 ] unit-test
 277
 278 [ int-4{ 1 22 33 4 } ]
 279 [ int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 } v? ] unit-test
 280
 281 [ int-4{ 1 22 33 4 } ]
 282 [
 283     int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 }
 284     [ { int-4 int-4 int-4 } declare v? ] compile-call
 285 ] unit-test
 286
 287 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 288 [ float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 } v? ] unit-test
 289
 290 [ float-4{ 1.0 22.0 33.0 4.0 } ]
 291 [
 292     float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 }
 293     [ { float-4 float-4 float-4 } declare v? ] compile-call
 294 ] unit-test
 295
 296 "== Checking shifts and permutations" print
 297
 298 [ int-4{ 256 512 1024 2048 } ]
 299 [ int-4{ 1 2 4 8 } 1 hlshift ] unit-test
 300
 301 [ int-4{ 256 512 1024 2048 } ]
 302 [ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
 303
 304 [ int-4{ 256 512 1024 2048 } ]
 305 [ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
 306
 307 [ int-4{ 1 2 4 8 } ]
 308 [ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
 309
 310 [ int-4{ 1 2 4 8 } ]
 311 [ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
 312
 313 [ int-4{ 1 2 4 8 } ]
 314 [ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
 315
 316 ! Invalid inputs should not cause the compiler to throw errors
 317 [ ] [
 318     [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
 319 ] unit-test
 320
 321 [ ] [
 322     [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
 323 ] unit-test
 324
 325 ! Shuffles
 326 : shuffles-for ( n -- shuffles )
 327     {
 328         { 2 [
 329             {
 330                 { 0 1 }
 331                 { 1 1 }
 332                 { 1 0 }
 333                 { 0 0 }
 334             }
 335         ] }
 336         { 4 [
 337             {
 338                 { 1 2 3 0 }
 339                 { 0 1 2 3 }
 340                 { 1 1 2 2 }
 341                 { 0 0 1 1 }
 342                 { 2 2 3 3 }
 343                 { 0 1 0 1 }
 344                 { 2 3 2 3 }
 345                 { 0 0 2 2 }
 346                 { 1 1 3 3 }
 347                 { 0 1 0 1 }
 348                 { 2 2 3 3 }
 349             }
 350         ] }
 351         { 8 [
 352             4 shuffles-for
 353             4 shuffles-for
 354             [ [ 4 + ] map ] map
 355             [ append ] 2map
 356         ] }
 357         [ dup '[ _ random ] replicate 1array ]
 358     } case ;
 359
 360 simd-classes [
 361     [ [ { } ] ] dip
 362     [ new length shuffles-for ] keep
 363     '[
 364         _ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
 365         [ = ] check-optimizer
 366     ] unit-test
 367 ] each
 368
 369 "== Checking vector tests" print
 370
 371 :: test-vector-tests-bool ( vector declaration -- none? any? all? )
 372     vector
 373     [ [ declaration declare vnone? ] compile-call ]
 374     [ [ declaration declare vany?  ] compile-call ]
 375     [ [ declaration declare vall?  ] compile-call ] tri ; inline
 376
 377 : yes ( -- x ) t ;
 378 : no ( -- x ) f ;
 379
 380 :: test-vector-tests-branch ( vector declaration -- none? any? all? )
 381     vector
 382     [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
 383     [ [ declaration declare vany?  [ yes ] [ no ] if ] compile-call ]
 384     [ [ declaration declare vall?  [ yes ] [ no ] if ] compile-call ] tri ; inline
 385
 386 SYMBOL: !!inconsistent!!
 387
 388 : ?inconsistent ( a b -- ab/inconsistent )
 389     2dup = [ drop ] [ 2drop !!inconsistent!! ] if ;
 390
 391 :: test-vector-tests ( vector decl -- none? any? all? )
 392     vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none
 393     vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none
 394
 395     bool-none branch-none ?inconsistent
 396     bool-any  branch-any  ?inconsistent
 397     bool-all  branch-all  ?inconsistent ; inline
 398
 399 [ f t t ]
 400 [ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test
 401 [ f t f ]
 402 [ float-4{ f t t t } { float-4 } test-vector-tests ] unit-test
 403 [ t f f ]
 404 [ float-4{ f f f f } { float-4 } test-vector-tests ] unit-test
 405
 406 [ f t t ]
 407 [ double-2{ t t } { double-2 } test-vector-tests ] unit-test
 408 [ f t f ]
 409 [ double-2{ f t } { double-2 } test-vector-tests ] unit-test
 410 [ t f f ]
 411 [ double-2{ f f } { double-2 } test-vector-tests ] unit-test
 412
 413 [ f t t ]
 414 [ int-4{ t t t t } { int-4 } test-vector-tests ] unit-test
 415 [ f t f ]
 416 [ int-4{ f t t t } { int-4 } test-vector-tests ] unit-test
 417 [ t f f ]
 418 [ int-4{ f f f f } { int-4 } test-vector-tests ] unit-test
 419
 420 [ f t t ]
 421 [ float-8{ t t t t t t t t } { float-8 } test-vector-tests ] unit-test
 422 [ f t f ]
 423 [ float-8{ f t t t t f t t } { float-8 } test-vector-tests ] unit-test
 424 [ t f f ]
 425 [ float-8{ f f f f f f f f } { float-8 } test-vector-tests ] unit-test
 426
 427 [ f t t ]
 428 [ double-4{ t t t t } { double-4 } test-vector-tests ] unit-test
 429 [ f t f ]
 430 [ double-4{ f t t f } { double-4 } test-vector-tests ] unit-test
 431 [ t f f ]
 432 [ double-4{ f f f f } { double-4 } test-vector-tests ] unit-test
 433
 434 [ f t t ]
 435 [ int-8{ t t t t t t t t } { int-8 } test-vector-tests ] unit-test
 436 [ f t f ]
 437 [ int-8{ f t t t t f f f } { int-8 } test-vector-tests ] unit-test
 438 [ t f f ]
 439 [ int-8{ f f f f f f f f } { int-8 } test-vector-tests ] unit-test
 440
 441 "== Checking element access" print
 442
 443 ! Test element access -- it should box bignums for int-4 on x86
 444 : test-accesses ( seq -- failures )
 445     [ length >array ] keep
 446     '[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline
 447
 448 [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
 449 [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-accesses ] unit-test
 450 [ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
 451
 452 [ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
 453 [ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
 454 [ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
 455
 456 [ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
 457 [ { } ] [ longlong-2{ 1 2 } test-accesses ] unit-test
 458 [ { } ] [ ulonglong-2{ 1 2 } test-accesses ] unit-test
 459
 460 [ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-accesses ] unit-test
 461 [ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
 462 [ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
 463
 464 [ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
 465 [ { } ] [ longlong-4{ 1 2 3 4 } test-accesses ] unit-test
 466 [ { } ] [ ulonglong-4{ 1 2 3 4 } test-accesses ] unit-test
 467
 468 "== Checking broadcast" print
 469 : test-broadcast ( seq -- failures )
 470     [ length >array ] keep
 471     '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline
 472
 473 [ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
 474 [ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test
 475 [ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-broadcast ] unit-test
 476
 477 [ { } ] [ double-2{ 1.0 2.0 } test-broadcast ] unit-test
 478 [ { } ] [ longlong-2{ 1 2 } test-broadcast ] unit-test
 479 [ { } ] [ ulonglong-2{ 1 2 } test-broadcast ] unit-test
 480
 481 [ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-broadcast ] unit-test
 482 [ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
 483 [ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
 484
 485 [ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
 486 [ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
 487 [ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
 488
 489 ! Make sure we use the fallback in the correct situations
 490 [ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
 491
 492 "== Checking alien operations" print
 493
 494 [ float-4{ 1 2 3 4 } ] [
 495     [
 496         float-4{ 1 2 3 4 }
 497         underlying>> 0 float-4-rep alien-vector
 498     ] compile-call float-4 boa
 499 ] unit-test
 500
 501 [ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [
 502     16 [ 1 ] B{ } replicate-as 16 <byte-array>
 503     [
 504         0 [
 505             { byte-array c-ptr fixnum } declare
 506             float-4-rep set-alien-vector
 507         ] compile-call
 508     ] keep
 509 ] unit-test
 510
 511 [ float-array{ 1 2 3 4 } ] [
 512     [
 513         float-array{ 1 2 3 4 } underlying>>
 514         float-array{ 4 3 2 1 } clone
 515         [ underlying>> 0 float-4-rep set-alien-vector ] keep
 516     ] compile-call
 517 ] unit-test
 518
 519 STRUCT: simd-struct
 520 { x float-4 }
 521 { y double-2 }
 522 { z double-4 }
 523 { w float-8 } ;
 524
 525 [ t ] [ [ simd-struct <struct> ] compile-call >c-ptr [ 0 = ] all? ] unit-test
 526
 527 [
 528     float-4{ 1 2 3 4 }
 529     double-2{ 2 1 }
 530     double-4{ 4 3 2 1 }
 531     float-8{ 1 2 3 4 5 6 7 8 }
 532 ] [
 533     simd-struct <struct>
 534     float-4{ 1 2 3 4 } >>x
 535     double-2{ 2 1 } >>y
 536     double-4{ 4 3 2 1 } >>z
 537     float-8{ 1 2 3 4 5 6 7 8 } >>w
 538     { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
 539 ] unit-test
 540
 541 [
 542     float-4{ 1 2 3 4 }
 543     double-2{ 2 1 }
 544     double-4{ 4 3 2 1 }
 545     float-8{ 1 2 3 4 5 6 7 8 }
 546 ] [
 547     [
 548         simd-struct <struct>
 549         float-4{ 1 2 3 4 } >>x
 550         double-2{ 2 1 } >>y
 551         double-4{ 4 3 2 1 } >>z
 552         float-8{ 1 2 3 4 5 6 7 8 } >>w
 553         { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
 554     ] compile-call
 555 ] unit-test
 556
 557 "== Misc tests" print
 558
 559 [ ] [ char-16 new 1array stack. ] unit-test
 560
 561 ! CSSA bug
 562 [ 8000000 ] [
 563     int-8{ 1000 1000 1000 1000 1000 1000 1000 1000 }
 564     [ { int-8 } declare dup [ * ] [ + ] 2map-reduce ] compile-call
 565 ] unit-test
 566
 567 ! Coalescing was too aggressive
 568 :: broken ( axis theta -- a b c )
 569    axis { float-4 } declare drop
 570    theta { float } declare drop
 571
 572    theta cos float-4-with :> cc
 573    theta sin float-4-with :> ss
 574
 575    axis cc v+ :> diagonal
 576
 577    diagonal cc ss ; inline
 578
 579 [ t ] [
 580     float-4{ 1.0 0.0 1.0 0.0 } pi [ broken 3array ]
 581     [ compile-call ] [ call ] 3bi =
 582 ] unit-test