1
// examples from the book Forth Primer..
2
// http://ficl.sourceforge.net/pdf/Forth_Primer.pdf
3

            
4
#[cfg(test)]
5
mod tests {
6
    //use super::*;
7
    use forth::forth_compiler::ForthCompiler;
8
    use forth::stack_machine::GasLimit;
9
    use forth::ForthError;
10

            
11
    macro_rules! clean_stack (
12
        {$fc: ident, $expr: expr, $result: expr} => {
13
            $fc.sm.st.data_stack.clear();
14
            $fc.execute_string($expr, GasLimit::Limited(100)).unwrap();
15
            assert_eq!($fc.sm.st.data_stack, $result);
16
        }
17
    );
18

            
19
    macro_rules! output (
20
        {$fc: ident, $expr: expr, $result: expr} => {
21
            assert_eq!($fc.execute_string($expr, GasLimit::Limited(500)).unwrap(), $result);
22
        }
23
    );
24

            
25
    macro_rules! error (
26
        {$fc: ident, $expr: expr, $result: expr} => {
27
            $fc.sm.st.data_stack.clear();
28
            assert_eq!($fc.execute_string($expr, GasLimit::Limited(100)).unwrap_err(), $result);
29
        }
30
    );
31

            
32
    macro_rules! run (
33
        {$fc: ident, $expr: expr} => {
34
            $fc.execute_string($expr, GasLimit::Limited(100)).unwrap()
35
        }
36
    );
37

            
38
    #[test]
39
2
    fn chapter2() {
40
1
        let mut fc = ForthCompiler::new();
41

            
42
        // page 9
43
1
        clean_stack!(fc, "1 2 +", vec![3]);
44
1
        clean_stack!(fc, "2 3 4 + *", vec![14]);
45

            
46
        // page 10
47
1
        clean_stack!(fc, "7 2 -", vec![5]);
48
1
        clean_stack!(fc, "2 7 -", vec![-5]);
49
1
        clean_stack!(fc, "12 3 /", vec![4]);
50
1
        clean_stack!(fc, "-12 3 /", vec![-4]);
51
1
        clean_stack!(fc, "4 5 + 2 *", vec![18]);
52
1
        clean_stack!(fc, "4 5 2 + *", vec![28]);
53
1
        clean_stack!(fc, "4 5 2 * -", vec![-6]);
54

            
55
1
        output!(fc, "2 3 . . CR", "3 2 \n");
56
1
        output!(fc, "2 3 swap . . CR", "2 3 \n");
57

            
58
1
        error!(fc, "2 . . cr", ForthError::DROPOfEmptyStack); // this doesn't really throw an error
59
                                                              //output!(fc, "2 . . cr", "2");
60
1
        output!(fc, "2 dup . . cr", "2 2 \n");
61

            
62
1
        output!(fc, "2 3 dup . . . cr", "3 3 2 \n");
63

            
64
        // page 11
65
1
        output!(fc, "2 3 over . . . cr", "2 3 2 \n");
66
1
        output!(fc, "2 3 drop .", "2 ");
67

            
68
1
        output!(fc, "1 2 3 . . . cr", "3 2 1 \n");
69
1
        output!(fc, "1 2 3 rot . . . cr", "1 3 2 \n");
70

            
71
        // page 12/13
72
1
        run!(
73
            fc,
74
            r#": *. * . ;     \ this will multiple and print two numbers."#
75
        );
76
1
        output!(fc, "2 3 *.", "6 ");
77

            
78
        // page 14
79
1
        output!(fc, r#".( Hello World!)"#, "Hello World!");
80
1
        output!(fc, r#"." Hello World!""#, "Hello World!");
81

            
82
1
        run!(fc, "variable one");
83
1
        run!(fc, "6 one !");
84
1
        output!(fc, "one @ .", "6 ");
85
1
        output!(fc, "one ?", "6 ");
86

            
87
        //page 15
88
1
        run!(fc, "5 constant five");
89
1
        output!(fc, "five spaces", "     ");
90

            
91
1
        run!(fc, "variable var");
92
1
        run!(fc, "4 var !");
93
1
        output!(fc, "var @ 5 > .", "0 ");
94

            
95
        // page 16
96

            
97
1
        run!(fc, "variable var");
98
1
        run!(fc, "4 var !");
99

            
100
1
        output!(
101
            fc,
102
            r#"
103
            : test
104
                var @ 5 >
105
                if ." Greater" cr
106
                else ." Less or equal" cr
107
                then
108
            ;
109
            test"#,
110
            "Less or equal\n"
111
        );
112

            
113
1
        output!(
114
            fc,
115
            r#"
116
            : test
117
                 11 1 do i . cr loop
118
            ;
119
            test"#,
120
            "1 \n2 \n3 \n4 \n5 \n6 \n7 \n8 \n9 \n10 \n"
121
        );
122

            
123
1
        output!(
124
            fc,
125
            r#"
126
            : test
127
                 0 0 ?do i . cr loop
128
            ;
129
            test"#,
130
            ""
131
        );
132

            
133
1
        output!(
134
            fc,
135
            r#"
136
            : test                         \ this is a comment too!
137
                11 1 do i . cr 2 +loop     \ this is a comment
138
            ;
139
            test"#,
140
            "1 \n3 \n5 \n7 \n9 \n"
141
        );
142

            
143
        // page 17
144
1
        output!(
145
            fc,
146
            r#"
147
             : test
148
               -11 -1 do i . cr -1 +loop
149
             ;
150
             test"#,
151
            "-1 \n-2 \n-3 \n-4 \n-5 \n-6 \n-7 \n-8 \n-9 \n-10 \n"
152
        );
153

            
154
1
        output!(
155
            fc,
156
            ": -TwoByTwo 0 10 DO I . -2 +LOOP ; -TwoByTwo",
157
            "10 8 6 4 2 "
158
        );
159

            
160
1
        output!(
161
            fc,
162
            r#"
163
             : test
164
                 16384 1 do i . i +loop
165
             ;
166
             test"#,
167
            "1 2 4 8 16 32 64 128 256 512 1024 2048 4096 8192 "
168
        );
169

            
170
        /*
171
        // unknown token "leave"
172
        output!(
173
            fc,
174
            r#"
175
             : test
176
                 10 0 do dup 5 = if drop leave else . cr then loop
177
             ;
178
             test"#,
179
            "0 \n1 \n2 \n3 \n4 "
180
        );
181
        */
182

            
183
1
        output!(
184
            fc,
185
            r#"
186
            : fib 0 1
187
                begin
188
                    dup >r rot dup r> >      \ condition
189
                while
190
                    rot rot dup rot + dup .  \ body
191
                repeat
192
                drop drop drop ;             \ after loop has executed"
193
            20 fib "#,
194
            "1 2 3 5 8 13 21 "
195
        );
196

            
197
        // page 18
198
        // problems with comments \
199

            
200
1
        output!(
201
            fc,
202
            r"
203
            : lcd
204
                begin
205
                    swap over mod         \ body
206
                    dup 0=                \ condition
207
                until drop . ;
208
            27 21 lcd",
209
            "3 "
210
        );
211

            
212
        // page 19
213
        /*
214
        output!(fc, r#"
215
             : number      ( a -- n)
216
                 0. Rot dup 1+ c@ [char] - = >r count r@ if 1 /string then >number nip
217
                 0= if d>s r> if negate then else r> drop 2drop (error) then ;
218

            
219
             : input#       ( -- n)
220
               begin
221
                   refill drop bl word number    ( n)
222
                   dup (error) <>                ( n f)
223
                   dup 0=                        ( n f -f)
224
                   if swap drop then             ( f | n f)
225
               until ;")
226

            
227
        */
228

            
229
1
        output!(fc, "140 . cr", "140 \n");
230
1
        output!(fc, "150 5 .r cr", "  150\n");
231
2
    }
232

            
233
    #[test]
234
    #[should_panic]
235
1
    fn chapter2_panic1() {
236
        // this will produce an infinite loop..
237

            
238
        let mut fc = ForthCompiler::new();
239

            
240
        run!(
241
            fc,
242
            r#"
243
             : test
244
                 begin ." Diamonds are forever" cr 0 until
245
             ;
246
             test"#
247
        );
248
1
    }
249

            
250
    #[test]
251
    #[should_panic]
252
1
    fn chapter2_panic2() {
253
        let mut fc = ForthCompiler::new();
254

            
255
        // this will produce an infinite loop..
256
        run!(
257
            fc,
258
            r#"
259
             : test
260
                 begin ." Diamonds are forever" cr again
261
             ;
262
             test"#
263
        );
264
1
    }
265

            
266
    #[test]
267
2
    fn chapter3() {
268
        //let mut fc = ForthCompiler::new();
269

            
270
        /*
271
        // page 21
272
        // create an array called sixteen with 16 cells
273
        run!(fc, "create sixteen 16 cells allot");
274
        run!(fc, "5 sixteen 0 cells + !");    // puts the value of 5 in the 0th cell
275
        run!(fc, "7 sixteen 8 cells + !");    // puts the value of 5 in the 0th cell
276

            
277
        output!(fc "sixteen 0 cells + @", "5 ");
278
        output!(fc "sixteen 8 cells + @", "7 ");
279

            
280
        // create an array of contants..
281
        run!(fc, "create sizes 18 , 21 , 24 , 27 , 30 , 255 ,");
282

            
283
        // page 22
284
        output!(fc, "sixteen 0 cells + @ .", "5 ");
285
        output!(fc, "sizes 0 cells + @ .", "18 ");
286

            
287
        // allocates (creates an arrya of chars)
288
        run!(fc, "create name 10 chars allot");
289
        run!(fc, "create hello 7 chars allot");
290

            
291
        run!(fc, "hello");
292
        run!(fc, "dup");
293
        run!(fc, "drop drop");
294

            
295
        run!(fc, ": place over over >r >r char+ swap chars cmove r> r> c! ;")
296
        run!(fc, "create name 16 chars allot");
297
        run!(fc, r"$" Hello! " name place");
298
        */
299

            
300
        /*
301
        run!(fc, ": place over over >r >r char+ swap chars cmove r> r> c! ;");
302
        run!(fc, "create greeting 32 chars allot   \ define string greeting");
303
        //run!(fc, r"S" Hello!" greeting place      \ set string to 'Hello!'");
304
        run!(fc, "greeting count                   \ get string length");
305
        run!(fc, ".( String length: ) . cr         \ print the length");
306
        run!(fc, "drop                             \ discard the address");
307

            
308
        run!(fc, ": place over over >r >r char+ swap chars cmove r> r> c! ;")
309
        run!(fc, ": length$ count swap drop ;")
310

            
311
        run!(fc, "create greeting 32 cells allot     \ define string greeting");
312
        run!(fc, r"s" Hello!"" greeting place       \ set string to 'Hello!'");
313
        run!(fc, "greeting legnth$                   \ get string length");
314
        run!(fc, ".( String length: ) . cr           \ print the length");
315

            
316
        run!(fc, "greeting count type cr             \ print the string", "Hello!");
317

            
318
        // page 24
319

            
320
        */
321
2
    }
322
}