core/kernel/kernel-tests.factor

   1 USING: arrays byte-arrays kernel kernel.private math memory
   2 namespaces sequences tools.test math.private quotations
   3 continuations prettyprint io.streams.string ;
   4 IN: temporary
   5
   6 [ 0 ] [ f size ] unit-test
   7 [ t ] [ [ \ = \ = ] all-equal? ] unit-test
   8
   9 ! Don't leak extra roots if error is thrown
  10 [ ] [ 10000 [ [ 3 throw ] catch drop ] times ] unit-test
  11
  12 [ ] [ 10000 [ [ -1 f <array> ] catch drop ] times ] unit-test
  13
  14 ! Make sure we report the correct error on stack underflow
  15 [ { "kernel-error" 11 f f } ]
  16 [ [ clear drop ] catch ] unit-test
  17
  18 [ { "kernel-error" 13 f f } ]
  19 [ [ { } set-retainstack r> ] catch ] unit-test
  20
  21 : overflow-d 3 overflow-d ;
  22
  23 [ { "kernel-error" 12 f f } ]
  24 [ [ overflow-d ] catch ] unit-test
  25
  26 : overflow-r 3 >r overflow-r ;
  27
  28 [ { "kernel-error" 14 f f } ]
  29 [ [ overflow-r ] catch ] unit-test
  30
  31 ! : overflow-c overflow-c 3 ;
  32 !
  33 ! [ { "kernel-error" 16 f f } ]
  34 ! [ [ overflow-c ] catch ] unit-test
  35
  36 [ -7 <byte-array> ] unit-test-fails
  37
  38 [ 2 3 4 1 ] [ 1 2 3 4 roll ] unit-test
  39 [ 1 2 3 4 ] [ 2 3 4 1 -roll ] unit-test
  40
  41 [ 3 ] [ t 3 and ] unit-test
  42 [ f ] [ f 3 and ] unit-test
  43 [ f ] [ 3 f and ] unit-test
  44 [ 4 ] [ 4 6 or ] unit-test
  45 [ 6 ] [ f 6 or ] unit-test
  46
  47 [ slip ] unit-test-fails
  48 [ 1 slip ] unit-test-fails
  49 [ 1 2 slip ] unit-test-fails
  50 [ 1 2 3 slip ] unit-test-fails
  51
  52 [ 5 ] [ [ 2 2 + ] 1 slip + ] unit-test
  53
  54 [ [ ] keep ] unit-test-fails
  55
  56 [ 6 ] [ 2 [ sq ] keep + ] unit-test
  57
  58 [ [ ] 2keep ] unit-test-fails
  59 [ 1 [ ] 2keep ] unit-test-fails
  60 [ 3 1 2 ] [ 1 2 [ 2drop 3 ] 2keep ] unit-test
  61
  62 [ 0 ] [ f [ sq ] [ 0 ] if* ] unit-test
  63 [ 4 ] [ 2 [ sq ] [ 0 ] if* ] unit-test
  64
  65 [ 0 ] [ f [ 0 ] unless* ] unit-test
  66 [ t ] [ t [ "Hello" ] unless* ] unit-test
  67
  68 [ "2\n" ] [ [ 1 2 [ . ] [ sq . ] ?if ] string-out ] unit-test
  69 [ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?if ] string-out ] unit-test
  70
  71 [ f ] [ f (clone) ] unit-test
  72 [ -123 ] [ -123 (clone) ] unit-test
  73
  74 [ 6 2 ] [ 1 2 [ 5 + ] dip ] unit-test
  75
  76 [ ] [ callstack set-callstack ] unit-test
  77 ! [ ] [ callstack callstack>array array>callstack set-callstack ] unit-test