44
45 (var i (if (= i1 i-min) i1 i2))
46 (put-integer i) ; 1
47 (put-line)
48
49 )
50
1 ; TestScopeZ.txt
2 ;
3 ; Copyright (C) 2012, coreBugZJ, all rights reserved.
4 ;
5 ; 测试用文件 C
6 ; ANSI GB2312 编码 www.2cto.com
7 ;
8 ; 综合测试 作用域，lambda，函数，环境模型
9
10
11
12 ; case 3
13 (begin
14 (func fs(fs_x)
15 (lambda (lam_y)
16 (set! fs_x (- fs_x lam_y))
17 (put-line (integer->string fs_x))
18 )
19 )
20 (var fa (fs 71))
21 (fa 3) ; 68
22 (fa 7) ; 61
23
24 (var fb (fs 100))
25 (fb 10) ; 90
26 (fa 3) ; 58
27 (fb 19) ; 71
28
29
30
31 )
32
33
34
35
36
37 ; case 2 ok
38 (begin
39 (var fs (lambda (x) (+ x x)))
40 (put-line (integer->string (fs 3)))
41 )
42
43
44
45 ; case 1 ok
46 (begin
47 (func put-integer(i)
48 (put-line (integer->string i))
49 )
50
51 (func fa(x) (+ x x))
52 (put-integer (fa 7))
53
54 (lambda (y) (- y y))
55 (put-integer ((lambda (z) (* z z)) 10))
56
57 ) ; end
58
1 ; TestPairZ.txt
2 ;
3 ; Copyright (C) 2012, coreBugZJ, all rights reserved.
4 ;
5 ; 测试用文件 D
6 ; ANSI GB2312 编码
7 ;
8 ; 测试 pair 系列基本函数
9
10
11 (begin
12 (put-string (list #x #a #b #c #d))
13 (put-line (list)) ; xabcd
14 (put-string (pair #x (pair #y nil)))
15 (put-line) ; xy
16
17 (var pa (pair 100 200))
18 (put-line (integer->string (first pa))) ; 100
19 (put-line (integer->string (rest pa))) ; 200
20
21
22 (func length(lis)
23 (if (nil lis)
24 0
25 (+ 1 (length (rest lis)))
26 )
27 )
28
29 (func put-integer(i)
30 (put-line (integer->string i))
31 )
32
33 (var la (pair 1 (pair 2 nil)))
34 (put-line (integer->string (length la))) ; 2
35
36 (var lb (list 1 2 3 4 5))
37 (put-line (integer->string (length lb))) ; 5
38
39
40 (put-integer (first la)) ; 1
41 (set! la (rest la))
42 (put-integer (first la)) ; 2
43 (set-first! la 6)
44 (put-integer (first la)) ; 6
45 (set-rest! la 7)
46 (set! la (rest la))
47 (put-integer la) ; 7
48
49 (var vn)
50 (put-integer (if (= nil vn) 1000 2000))
51
52 )
53
1 ; TestGcZ.txt
2 ;
3 ; Copyright (C) 2012, coreBugZJ, all rights reserved.
4 ;
5 ; 测试用文件 E
6 ; ANSI GB2312 编码
7 ;
8 ; 测试垃圾收集
9
10
11
12 (begin
13 (func new(n)
14 (if (= 0 n)
15 nil
16 (pair n (new (- n 1)))
17 )
18 )
19
20 (var ref)
21
22 (func test-gc(n)
23 (if (= 0 n)
24 nil
25 (begin
26 (set! ref (new 2))
27 (test-gc (- n 1))
28 )
29 )
30 )
31
32 (test-gc 2)
33
34 )
35
1 ; TestErrorZ.txt
2 ;
3 ; Copyright (C) 2012, coreBugZJ, all rights reserved.
4 ;
5 ; 测试用文件 F
6 ; ANSI GB2312 编码
7 ;
8 ; 测试错误定位
9
10
11 (begin
12 (var a "a")
13 (var b 3)
14 (var c $) ; error lin=14 col=16
15 (if (= a b) a b) ; error lin=15 col=13
16 )
17
摘自 coreBugZJ