source: project/release/4/srfi-29/trunk/tests/srfi-29-test.scm @ 35217

Last change on this file since 35217 was 35217, checked in by kon, 5 months ago

use moremacros - warning checked parameters , re-flow , use csi+csc test runner

File size: 7.5 KB
Line 
1;;;; srfi-29-test.scm
2
3;To use w/ TLS:
4;(cd .../srfi-29/trunk/tests; \
5;sudo csi -n -R posix -e '(setenv "SRFI29_TLS" "1")' -s run.scm)
6
7(use test)
8(use srfi-29)
9(use posix)
10
11(define (allow-sysops?)
12  (or
13    (eq? 'windows (software-type))
14    (= 0 (current-effective-user-id))) )
15
16(test-group "SRFI 29 Basics"
17
18  (let ((bal1 '((foo1 . 1) ("bar1" . 2) (baz1 . 3)))
19        (bal2 '((foo2 . 4) ("bar2" . 5) (baz2 . 6)))
20        (bal3 '((foo3 . 7) ("bar3" . 8) (baz3 . 9))) )
21
22    (test-group "Locale"
23
24      (test-assert "L1" (current-language))
25      (test-assert "L2" (current-country))
26      (test-assert "L3" (current-locale-details))
27
28      (test-assert "L4" (symbol? (current-language)))
29      (test-assert "L5" (symbol? (current-country)))
30      (test-assert "L6" (list? (current-locale-details)))
31
32      (test-assert "L7" (current-language 'foo))
33      (test-assert "L8" (current-country 'bar))
34      (test-assert "L9" (current-locale-details '(baz)))
35
36      (test "L10" 'foo (current-language))
37      (test "L11" 'bar (current-country))
38      (test "L12" '(baz) (current-locale-details))
39
40      (reset-locale-parameters)
41    )
42
43    (test-group "Bundles"
44
45      (test-assert "" (declare-bundle! '(srfi-29-test) bal1))
46      (test-assert "" (declare-bundle! '(srfi-29-test foo) bal2))
47      (test-assert "" (declare-bundle! '(srfi-29-test foo bar) bal3))
48
49      (test "declared-bundle-specifiers (uses internal list order; brittle)"
50            '((srfi-29-test foo bar) (srfi-29-test foo) (srfi-29-test))
51            (declared-bundle-specifiers))
52      (test "declared-bundle-templates" bal1 (declared-bundle-templates '(srfi-29-test)))
53      (test "declared-bundle-templates foo" bal2 (declared-bundle-templates '(srfi-29-test foo)))
54      (test "declared-bundle-templates foo bar" bal3 (declared-bundle-templates '(srfi-29-test foo bar)))
55
56      (test "" 1 (localized-template 'srfi-29-test 'foo1))
57      (test "" 2 (localized-template 'srfi-29-test "bar1"))
58      (test "" 3 (localized-template 'srfi-29-test 'baz1))
59
60      (test-assert "" (undeclare-bundle! '(srfi-29-test)))
61      (test-assert "" (undeclare-bundle! '(srfi-29-test foo)))
62      (test-assert "" (undeclare-bundle! '(srfi-29-test foo bar)))
63
64      (test-assert "" (not (localized-template 'srfi-29-test 'foo1)))
65      (test-assert "" (not (localized-template 'srfi-29-test "bar1")))
66      (test-assert "" (not (localized-template 'srfi-29-test 'baz1)))
67    )
68
69    (test-group "Bundles Alternate Directory"
70
71      (define altdir ".")
72
73      (test-assert "B1" (declare-bundle! '(srfi-29-test) bal1))
74      (test-assert "B2" (declare-bundle! '(srfi-29-test foo) bal2))
75      (test-assert "B3" (declare-bundle! '(srfi-29-test foo bar) bal3))
76
77      (test-assert "B7" (store-bundle! '(srfi-29-test) altdir))
78      (test-assert "B8" (store-bundle! '(srfi-29-test foo) altdir))
79      (test-assert "B9" (store-bundle! '(srfi-29-test foo bar) altdir))
80
81      (test-assert "B10" (remove-bundle! '(srfi-29-test) altdir))
82      (test-assert "B11" (remove-bundle! '(srfi-29-test foo) altdir))
83      (test-assert "B12" (remove-bundle! '(srfi-29-test foo bar) altdir))
84
85      (test-assert "B13" (not (load-bundle! '(srfi-29-test) altdir)))
86      (test-assert "B14" (not (load-bundle! '(srfi-29-test foo) altdir)))
87      (test-assert "B15" (not (load-bundle! '(srfi-29-test foo bar) altdir)))
88
89      (test-assert "AltDir RmDir" (remove-bundle-directory! '(srfi-29-test foo bar) altdir))
90    )
91
92    (when (allow-sysops?)
93      (test-group "Bundles System Directory"
94
95        (test-assert "B16" (declare-bundle! '(srfi-29-test) bal1))
96        (test-assert "B17" (declare-bundle! '(srfi-29-test foo) bal2))
97        (test-assert "B18" (declare-bundle! '(srfi-29-test foo bar) bal3))
98
99        (test-assert "B19" (store-bundle! '(srfi-29-test)))
100        (test-assert "B20" (store-bundle! '(srfi-29-test foo)))
101        (test-assert "B21" (store-bundle! '(srfi-29-test foo bar)))
102
103        (test-assert "B22" (undeclare-bundle! '(srfi-29-test)))
104        (test-assert "B23" (undeclare-bundle! '(srfi-29-test foo)))
105        (test-assert "B24" (undeclare-bundle! '(srfi-29-test foo bar)))
106
107        (test-assert "B25.1" (not (localized-template 'srfi-29-test 'foo1)))
108        (test-assert "B26.1" (not (localized-template 'srfi-29-test "bar1")))
109        (test-assert "B27.1" (not (localized-template 'srfi-29-test 'baz1)))
110
111        (test-assert "B22.1" (load-bundle! '(srfi-29-test)))
112        (test-assert "B23.1" (load-bundle! '(srfi-29-test foo)))
113        (test-assert "B24.1" (load-bundle! '(srfi-29-test foo bar)))
114
115        (test "B25" 1 (localized-template 'srfi-29-test 'foo1))
116        (test "B26" 2 (localized-template 'srfi-29-test "bar1"))
117        (test "B27" 3 (localized-template 'srfi-29-test 'baz1))
118
119        (test "localized-templates" bal1 (localized-templates 'srfi-29-test))
120
121        (current-language 'foo)
122
123        (test "B28" 4 (localized-template 'srfi-29-test 'foo2))
124        (test "B29" 5 (localized-template 'srfi-29-test "bar2"))
125        (test "B30" 6 (localized-template 'srfi-29-test 'baz2))
126
127        (test "localized-templates language foo" bal2 (localized-templates 'srfi-29-test))
128
129        (current-country 'bar)
130
131        (test "B31" 7 (localized-template 'srfi-29-test 'foo3))
132        (test "B32" 8 (localized-template 'srfi-29-test "bar3"))
133        (test "B33" 9 (localized-template 'srfi-29-test 'baz3))
134
135        (test "localized-templates language foo, country bar"
136          bal3 (localized-templates 'srfi-29-test))
137
138        (test-assert "B37.1" (localized-template-set! 'srfi-29-test 'baz3 'foobar))
139        (test "B37.2" 'foobar (localized-template 'srfi-29-test 'baz3))
140        (test-assert "B37.3" (not (localized-template-set! 'foobar 'baz3 #t)))
141        (test-assert "B37.4" (localized-template-set! 'srfi-29-test 'barf 16))
142        (test "B37.5" 16 (localized-template 'srfi-29-test 'barf))
143
144        (test-assert "B34" (remove-bundle! '(srfi-29-test)))
145        (test-assert "B35" (remove-bundle! '(srfi-29-test foo)))
146        (test-assert "B36" (remove-bundle! '(srfi-29-test foo bar)))
147
148        (test-assert "SysDir RmDir" (remove-bundle-directory! '(srfi-29-test foo bar)))
149
150        (reset-locale-parameters)
151      )
152    )
153  )
154
155  #;(test-assert "B22.2" (load-best-available-bundle! (most-specific-bundle-specifier 'srfi-19)))
156  #;(test "B22.3 English" "August" (localized-template 'srfi-19 'august))
157  #;(test "B22.4 English" "December" (localized-template 'srfi-19 'december))
158)
159
160(test-group "SRFI 29 Logic"
161
162  ;for compile & load so extension assumed
163  (define test-logic-filename "test-logic")
164
165  ;compile logic
166  (system (string-append "csc -s " test-logic-filename))
167
168  ;declare logic pkg
169  (declare-bundle! '(srfi-29-test)
170    `((library . ,test-logic-filename)          ;pathname of compiled logic (for load)
171      (proc* . (srfi-29-test . test-star))      ;module ident
172      (proc0 . srfi-29-test-0)                  ;0 arg proc
173      (proc1 . srfi-29-test-1)                  ;1 arg proc
174      (procN . srfi-29-test-N)))                ;N arg proc
175  (define !item@ (make-required-localized-template 'srfi-29-test))
176  (test-assert (procedure? !item@))
177
178  ;load logic
179  (load-localized-compiled-code
180    (!item@ 'library)
181    'srfi-29-test
182    '(proc0 proc1 procN proc*))
183
184  ;test logic
185  (test-assert (procedure? (!item@ 'proc0)))
186  (test-assert (procedure? (!item@ 'proc1)))
187  (test-assert (procedure? (!item@ 'procN)))
188  (test-assert (procedure? (!item@ 'proc*)))
189
190  (test 0 ((!item@ 'proc0)))
191  (test -56 ((!item@ 'proc1) 56))
192  (test '(1 2 3 4 5 6) ((!item@ 'procN) 1 2 3 4 5 6))
193  (test '(* hello) ((!item@ 'proc*) 'hello))
194)
195
196(test-exit)
Note: See TracBrowser for help on using the repository browser.