source: project/release/5/slib-prec/trunk/tests/slib-prec-test.scm @ 39037

Last change on this file since 39037 was 39037, checked in by Kon Lovett, 5 weeks ago

add shift ops, % -> mod, add rem

File size: 4.8 KB
Line 
1;;;; slib-prec-test.scm  -*- scheme -*-
2;;;; Kon Lovett, Apr '20
3
4(import test)
5
6(test-begin "SLIB Precedence Parser")
7
8(import slib-prec)
9
10;;
11
12;;;
13
14(import (chicken base))
15(import (only (chicken port) with-input-from-string))
16(import utf8 utf8-srfi-13)
17
18;; Operator Aliaes
19
20;; Grammars
21
22;defgrammar doesn't `define'
23(import slib-basic-grammars)
24(import slib-standard-grammar)  ;(from JACAL English.scm)
25(import slib-tex-grammar)
26
27;FIXME have grammar module register ID, need auto-default so always active grammar (if loaded)
28;init by id-# grammar lookup
29(define-constant TEST-GRAMMARS '(standard disp2d tex null scheme schemepretty))
30(clear-grammar-ids)
31(grammar-id-name-setup! TEST-GRAMMARS)
32(active-grammar-set! 'standard #f 'schemepretty)
33
34;;
35
36(test-group "Grammer IDs"
37  (test (length TEST-GRAMMARS) (count-of-grammar-ids))
38  (test 'standard (grammar-id-name 0))
39  (test 'scheme (grammar-id-name 4))
40)
41
42;;
43
44(define (read-sexp/string str #!optional (grammar (active-input-grammar)) (column 0))
45  (with-input-from-string str (cut read-sexp grammar column)) )
46
47(define (read-sexps/string str #!optional (grammar (active-input-grammar)) (column 0))
48  (with-input-from-string str (cut read-sexps grammar column)) )
49
50(test-group "Scheme Grammer"
51
52  (test-group "Arithmetic"
53    (test '(+ 1 (* 2 a)) (read-sexp/string "1 + 2 * a"))
54    (test '(+ 1 2 (* abc a)) (read-sexp/string "1 + 2 + abc * a"))
55    (test '(* (+ 1 2) (f a b)) (read-sexp/string "(1 + 2) * f(a, b)"))
56    (test '(/ (expt (+ 1 2) (f a b)) x) (read-sexp/string "(1 + 2) ** f(a, b) / x"))
57  )
58
59  (test-group "Logical"
60    (test
61      '(or (/ (* (+ 1 2) (f a b)) 27.9) PI)
62      (read-sexp/string "(1 + 2) * f(a, b) / 27.9 || PI"))
63    (test
64      '(and (/ (* (+ 1 2) (f a b)) 27.9) PI)
65      (read-sexp/string "(1 + 2) * f(a, b) / 27.9 && PI"))
66    (test
67      '(or (< a b) (and (f x) (> i (+ (modulo j 3) x))))
68      (read-sexp/string "a < b || f(x) && i > j mod 3 + x"))
69    (test
70      '(or (and BAZ PI) (and FOO BAR))
71      (read-sexp/string "BAZ && PI || FOO && BAR"))
72    (test
73      '(or (and BAZ PI) (and (not FOO) BAR))
74      (read-sexp/string "BAZ && PI || !FOO && BAR"))
75  )
76
77  (test-group "Bitwise"
78    (test
79      '(bitwise-ior a (bitwise-and b c) (bitwise-and (bitwise-not b) d))
80      (read-sexp/string "a | b & c | ~b & d"))
81    (test
82      '(bitwise-xor (bitwise-ior a (bitwise-and b c)) (bitwise-ior (bitwise-not b) d))
83      (read-sexp/string "a | b & c ^ ~b | d"))
84  )
85
86  (test-group "Define & Lambda"
87    (test
88      '(define f (lambda a (+ (first a) (second a)) (apply r a)))
89      (read-sexp/string "f := \\a, first(a) + second(a), apply(r, a);"))
90
91    ;FIXME handle ratios / in a/b vs a / b ?
92    #; ; "N/D (ratio) => (/ N D)"
93    (test '(* (+ 1 2) 1/5) (read-sexp/string "(1 + 2) * 1/5"))
94    ;#; ;
95    (test '(/ (* (+ 1 2) 1) 5) (read-sexp/string "(1 + 2) * 1/5"))
96
97    #; ;FIXME handle lambda arguments
98    (test
99      '(define f (lambda (a b) (- a b) (+ a b)))
100      (with-input-from-string
101        "f := \\(a,b), a-b, a + b;"
102        read-sexps))
103
104    ;FIXME handle complex
105  )
106
107  (test-group "Multiple Expressions ;"
108    (test
109      '(begin (+ (first a) (second a)) (apply r a) (- 23 skidoo))
110      (read-sexps/string
111        "first(a) + second(a); apply(r, a); 23-skidoo"))
112
113    ;FIXME handle infinities & nan
114    (test
115      '(begin (define f (lambda a (+ (first a) (second a)) (apply r a))) (f 1 (+ inf.0)))
116      (read-sexps/string
117       ;NOTE ;; is lambda-right-delim + expression-delim
118        "/* (define f (lambda a ...)) */ f := \\a, first(a) + second(a), apply(r, a);; f(1,+inf.0)"))
119  )
120
121  (test-group "Evaluate Expression"
122    ;NOTE whitespace is not a delimiter
123    (test 15 (eval (read-sexp/string "(1 +2)* 5;")))
124    (test 15.0 (eval (read-sexp/string "(1.0+ 2) * 5")))
125    (test 3/5 (eval (read-sexp/string "(1 + 2) *1/5")))
126    (test 8 (eval (read-sexp/string "2 **3")))
127    (test #(1 2 3) (eval (read-sexp/string "[1,2,1+2]")))
128    (test '(1 2 3) (eval (read-sexp/string "{1,2,1+2}")))
129  )
130
131  (test-group "Evaluate Expressions ;"
132    (test #(1 2 3) (eval (read-sexps/string "1+2; [1,2,1+2]")))
133  )
134)
135
136;;
137
138#| ;comment to activate for csi (csc needs extension)
139(read-syntax-setup!)
140
141(test-group "Reader #{...}"
142  (test "w/ spaces" 3/5 #{ (1 + 2) / 5 }) ;(* (+ 1 2) 5)
143  (test "w/o spaces" 3/5 #{(1+2)/5})      ;(* (+ 1 2) 5)
144  (test 1 #{ {1} })                       ;(or 1)
145  (test #(1) #{ [1] })                    ;(vector 1)
146  (test 8 #{ expt(2, 3) })                ;(expt 2 3)
147  (test 8 #{ 2**3 })                      ;(expt 2 3)
148)
149
150(test-group "Reader #<id>{...}"
151  (test 15 #0{(1 + 2) * 5}) ;(* (+ 1 2) 5)
152  (test 1 #0{{1}})          ;(or 1)
153  (test 8 #0{expt(2,3)})    ;(expt 2 3)
154  (test 8 #0{2^3})          ;(expt 2 3)
155  (test #(1) #0{[1]})       ;(vector 1)
156  (test #(1) #1{[1]})       ;(vector 1)
157)
158|#
159
160;;;
161
162(test-end "SLIB Precedence Parser")
163
164::
165
166(test-exit)
Note: See TracBrowser for help on using the repository browser.