xref: /titanic_51/usr/src/common/ficl/test/ficltest.fr (revision ccdeb6b6d71f3c9aa7e78b688f7b34fff109a817)
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
18include tester.fr
19include core.fr
20
21{ -> }
22\ test double stuff
23testing 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
34testing 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
40testing :noname
41{ :noname 1 ; execute -> 1 }
42{ 1 2 3 -rot -> 3 1 2 }
43
44testing default search order
45{ get-order -> forth-wordlist 1 }
46{ only definitions get-order -> forth-wordlist 1 }
47
48testing forget
49here constant fence
50{ fence forget fence -> here }
51
52testing 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
62testing 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
73testing refill
74\ from file loading
750 [if]
76.( Error )
77[else]
781 [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
89testing prefixes
90{ 0x10 -> decimal 16 }
91{ hex 0d10 -> decimal 10 }
92{ hex 100
93-> decimal 256 }
94
95testing number builder
96{ 1 -> 1 }
97{ 3. -> 3 0 }
98
99
100s" ficlwin" environment?
101[if]
102drop
103testing OOP support
104include ooptest.fr
105[endif]
106