usr/src/common/ficl/test/ficltest.fr

   1 \ test file for ficl
   2 \ test ANSI CORE stuff first...
   3 -1 set-order
   4
   5 \ set up local variable regressions before { gets redefined!
   6 : local1 { a b c | clr -- c b a 0 }
   7     c b a clr
   8 ;
   9
  10 : local2 { | clr -- 0 } clr ;
  11 : local3 { a b | c }
  12     a to c
  13     b to a
  14     c to b
  15     a b
  16 ;
  17
  18 include tester.fr
  19 include core.fr
  20
  21 { -> }
  22 \ test double stuff
  23 testing 2>r 2r> 2r@
  24 : 2r1  2>r r> r> swap ;
  25 : 2r2  swap >r >r 2r> ;
  26 : 2r3  2>r 2r@ R> R> 2DUP >R >R SWAP 2r> ;
  27
  28 { 1 2 2r1 -> 1 2 }
  29 { 1 2 2r2 -> 1 2 }
  30 { 1 2 2r3 -> 1 2 1 2 1 2 }
  31 { -> }
  32
  33 \ Now test ficl extras and optional word-sets
  34 testing locals
  35 { 1 2 3 local1 -> 3 2 1 0 }
  36 { local2 -> 0 }
  37 { 1 local2 -> 1 0 }
  38 { 1 2 local3 -> 2 1 }
  39
  40 testing :noname
  41 { :noname 1 ; execute -> 1 }
  42 { 1 2 3 -rot -> 3 1 2 }
  43
  44 testing default search order
  45 { get-order -> forth-wordlist 1 }
  46 { only definitions get-order -> forth-wordlist 1 }
  47
  48 testing forget
  49 here constant fence
  50 { fence forget fence -> here }
  51
  52 testing within
  53 { -1 1 0    within -> true }
  54 {  0 1s 2   within -> true }
  55 { -100 0 -1 within -> true }
  56 { -1 1 2    within -> false }
  57 { -1 1 -2   within -> false }
  58 { 1 -5 5    within -> true }
  59 { 33000 32000 34000 within -> true }
  60 { 0x80000000 0x7f000000 0x81000000 within -> true }
  61
  62 testing exception words
  63 : exc1 1 throw ;
  64 : exctest1 [ ' exc1 ] literal catch ;
  65 : exc2 exctest1 1 = if 2 throw endif ;
  66 : exctest2 [ ' exc2 ] literal catch ;
  67 : exctest? ' catch ;
  68
  69 { exctest1 -> 1 }
  70 { exctest2 -> 2 }
  71 { exctest? abort -> -1 }
  72
  73 testing refill
  74 \ from file loading
  75 0 [if]
  76 .( Error )
  77 [else]
  78 1 [if]
  79 [else]
  80 .( Error )
  81 [then]
  82 [then]
  83
  84 \ refill from evaluate string
  85 { -> }
  86 { s" 1 refill 2 " evaluate -> 1 0 2 }
  87
  88
  89 testing prefixes
  90 { 0x10 -> decimal 16 }
  91 { hex 0d10 -> decimal 10 }
  92 { hex 100
  93 -> decimal 256 }
  94
  95 testing number builder
  96 { 1 -> 1 }
  97 { 3. -> 3 0 }
  98
  99
 100 s" ficlwin" environment?
 101 [if]
 102 drop
 103 testing OOP support
 104 include ooptest.fr
 105 [endif]