Chicken Shen

Check-in [c436a763cc]
Login
Overview
Comment:Added more tests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:c436a763cc5ee28f22c7034a4cb9f0791c929cc04fb1f65cf65df99942915024
User & Date: david 2019-02-01 02:14:15
Context
2019-02-01
02:14
Removed old test file check-in: 8dc958869b user: david tags: trunk, v0.1
02:14
Added more tests check-in: c436a763cc user: david tags: trunk
00:09
Updated shen.egg check-in: cfd9945c91 user: david tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/run.scm.

1
2
3

4
5
6
7
8
9
10
..
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34











































35
36
37








38
39
40
41
42
43
44
45
46
47
48
(import
  srfi-1
  test

  shen)

(define true-tests
  `(
    ("string concat"   . (= "FOO" (cn "FOO" "")))
    ("string concat"   . (= "FOO" (cn "" "FOO")))
    ("string position" . (= "FOO" (cn (pos "FOO" 0) (tlstr "FOO"))))
................................................................................
    ("hd / cons"       . (= x (hd (cons x y))))
    ("tl / cons"       . (= y (tl (cons x y))))
    ("eval-kl"         . (= 3 (eval-kl (cons + (cons 1 (cons 2 ()))))))
    ("partial"         . (= (+ 1 2) ((+ 1) 2)))            
    ("boolean/true"    . (boolean? (intern "true")))
    ("boolean/false"   . (boolean? (intern "false")))))

  (define false-tests
    `(
      ("symbol/true"       . (symbol? (intern "true")))
      ("symbol/false"      . (symbol? (intern "false")))
      ("symbol/lambda"     . (symbol? (lambda X X)))
      ("symbol/stinput"    . (symbol? (value *stinput*)))
      ("trap-error/simple" . (trap-error (simple-error "")
					 (lambda E (symbol? E))))
      ("symbol/empty"      . (symbol? ()))))












































  (test-begin "should be true")
  (for-each
   (lambda (t)








     (test (car t) #t (eval-without-macros (cdr t))))
   true-tests)
  (test-end "should be true")

  (test-begin "should be false")
  (for-each
   (lambda (t)
     (test (car t) #f (eval-without-macros (cdr t))))
   false-tests)
  (test-end "should be false")
  (test-exit)

<

>







 







|
|
|
|
|
|
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
>
>
>
>
>
>
>
|
|
|

|
|
|
|
|
|
|
1

2
3
4
5
6
7
8
9
10
..
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
(import

  test
  srfi-1
  shen)

(define true-tests
  `(
    ("string concat"   . (= "FOO" (cn "FOO" "")))
    ("string concat"   . (= "FOO" (cn "" "FOO")))
    ("string position" . (= "FOO" (cn (pos "FOO" 0) (tlstr "FOO"))))
................................................................................
    ("hd / cons"       . (= x (hd (cons x y))))
    ("tl / cons"       . (= y (tl (cons x y))))
    ("eval-kl"         . (= 3 (eval-kl (cons + (cons 1 (cons 2 ()))))))
    ("partial"         . (= (+ 1 2) ((+ 1) 2)))            
    ("boolean/true"    . (boolean? (intern "true")))
    ("boolean/false"   . (boolean? (intern "false")))))

(define false-tests
  `(
    ("symbol/true"       . (symbol? (intern "true")))
    ("symbol/false"      . (symbol? (intern "false")))
    ("symbol/lambda"     . (symbol? (lambda X X)))
    ("symbol/stinput"    . (symbol? (value *stinput*)))
    ("trap-error/simple" . (trap-error (simple-error "")
				       (lambda E (symbol? E))))
    ("symbol/empty"      . (symbol? ()))))

(define eval-tests
  `(
    ("code"     (string->n "a")   97)
    ("char"     (n->string 97)   "a")
    ("pos"      (pos "ABC" 0)    "A")
    ("cn"       (cn "A" "B")    "AB")
    ("plus"     (+ 1 1)            2)
    ("minus"    (- 3 1)            2)
    ("divide"   (/ 64 8)           8)
    ("multiply" (* 3 3)            9)
    ("trap-error" (trap-error
		   (/ 3 0)
		   (lambda E (error-to-string E))) "division by zero")))

(define klambda-tests
  `(
    ("cons"   (cons A B)       (cons (quote A) (quote B)))
    ("freeze" (freeze (+ 1 1)) (lambda () (+ 1 1)))
    ("cons?"  (cons? A)        (pair? (quote A)))
    ("str"    (str A)          (kl:str (quote A)))
    ("set"    (set A "ABC")    (kl:set (quote A) "ABC"))
    ("time"   (get-time real)  (kl:get-time (quote real)))
    ("lambda" (lambda X (+ X 1))    (lambda (X) (+ X 1)))
    ("defun"  (defun foo (X) (+ X 1))
     (begin
       (register-function-arity (quote foo) 1)
       (define (kl:foo X)
	 (+ X 1))
       (quote foo)))))

;;;  ____                _____         _
;;; |  _ \ _   _ _ __   |_   _|__  ___| |_ ___
;;; | |_) | | | | '_ \    | |/ _ \/ __| __/ __|
;;; |  _ <| |_| | | | |   | |  __/\__ \ |_\__ \
;;; |_| \_\\__,_|_| |_|   |_|\___||___/\__|___/

(test-begin "Evaluation")
(for-each
 (lambda (t)
   (test (car t) (caddr t) (eval (kl->scheme (cadr t)))))
 eval-tests)
(test-end "Evaluation")
	    
(test-begin "K-Lambda")
(for-each
 (lambda (t)
   (test (car t) (caddr t) (kl->scheme (cadr t))))
 klambda-tests)
(test-end "K-Lambda")


(test-begin "Statements should be true")
(for-each
 (lambda (t)
   (test (car t) #t (eval-without-macros (cdr t))))
 true-tests)
(test-end "Statements should be true")

(test-begin "Statements should be false")
(for-each
 (lambda (t)
   (test (car t) #f (eval-without-macros (cdr t))))
 false-tests)
(test-end "Statements should be false")
(test-exit)