source: project/release/5/apropos/trunk/tests/apropos-test.scm @ 35819

Last change on this file since 35819 was 35819, checked in by Kon Lovett, 19 months ago

C5 initial

File size: 4.4 KB
Line 
1;;;; apropos-test.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3
4(import test)
5
6(test-begin "Apropos")
7
8;;;
9
10(import
11  (chicken syntax)
12  (chicken sort)
13  apropos)
14
15;FIXME need #:split tests
16
17;;
18
19(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
20(define (car-symbol<? a b) (symbol<? (car a) (car b)))
21(define (cdar-symbol<? a b) (symbol<? (cdar a) (cdar b)))
22
23;;;
24
25;; build test symbols
26
27(define (foobarproc0) 'foobarproc0)
28(define (foobarproc1 a) 'foobarproc1)
29(define (foobarproc2 a b) 'foobarproc2)
30(define (foobarprocn a b . r) 'foobarprocn)
31
32(define foobarprocx (lambda (a b c) 'foobarprocx))
33
34;RQRD due to use of macro identifiers
35(declare (compile-syntax))
36
37(define-syntax foobarmacro1
38  (er-macro-transformer
39    (lambda (f r c)
40      'foobarmacro1 ) ) )
41
42(define-syntax foobarmacro2
43  (syntax-rules ()
44    ((_) 'foobarmacro1 ) ) )
45
46(define foobarvar1 'foobarvar1)
47(define foobarvar2 'foobarvar2)
48
49(define Foobarvar1 'Foobarvar1)
50(define Foobarvar2 'Foobarvar2)
51
52#;(define (foocoreinline flag) (##core#inline "C_set_gc_report" flag))
53#;(define fooprimitive (##core#primitive "C_get_memory_info"))
54
55(define ##foo#bar1 '##foo#bar1)
56(define ##foo#bar2 (lambda () '##foo#bar2))
57
58(define ##bar#foo1 '##bar#foo1)
59(define ##bar#foo2 (lambda () '##bar#foo2))
60
61;; test for symbols
62
63(define (apropos-list-test lst val)
64  (test "apropos-list" (sort lst symbol<?) (sort val symbol<?)) )
65
66(apropos-list-test
67  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
68  (apropos-list 'foobar))
69(apropos-list-test
70  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
71  (apropos-list "foobar"))
72(apropos-list-test
73  '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2)
74  (apropos-list 'foo #:macros? #t #:qualified? #t))
75(apropos-list-test
76  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 foobarmacro1 foobarmacro2)
77  (apropos-list 'foobar #:macros? #t))
78(apropos-list-test
79  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 Foobarvar2 Foobarvar1)
80  (apropos-list 'foobar #:case-insensitive? #t))
81(apropos-list-test
82  '(foobarvar2 foobarvar1 Foobarvar1 Foobarvar2)
83  (apropos-list ''".+barvar[12]"))
84
85;;
86
87(define (apropos-information-list-test lst val)
88  (test "apropos-information-list" (sort lst cdar-symbol<?) (sort val cdar-symbol<?)) )
89
90#|
91#;14> (define foobarprocx (lambda (a b c) 'foobarprocx))
92#;15> '(((|| . foobarmacro1) . macro))
93(((||: . foobarmacro1) . macro))
94#;16> '(((||: . foobarmacro1) . macro))
95(((: . foobarmacro1) . macro))
96#;17> ||
97||:
98#;18> ||:
99
100Error: unbound variable: :
101#;19> #:||
102||:
103#;20> (eq? #:|| #:||)
104#t
105#;21> (caaar (apropos-information-list 'foobarproc))
106||:
107#;22> (eq? #:|| (caaar (apropos-information-list 'foobarproc)))
108#f
109|#
110
111(cond-expand
112  (compiling
113    ;reads (|| . foobarmacro1) as ( . foobarmacro1)
114    )
115  (else
116    ;oh , my : #:|| from reader is not eq? #:|| from symbol-table
117    (apropos-information-list-test
118      '(
119        ((|| . foobarmacro1) . macro)
120        ((|| . foobarmacro2) . macro)
121        ((|| . foobarproc0) procedure)
122        ((|| . foobarproc1) procedure a)
123        ((|| . foobarproc2) procedure a b)
124        ((|| . foobarprocn) procedure a b . r)
125        ((|| . foobarprocx) procedure a b c)
126        ((|| . foobarvar1) . variable)
127        ((|| . foobarvar2) . variable) )
128      (apropos-information-list 'foobar #:macros? #t #:qualified? #t))
129    (test "apropos-information-list"
130      '(((|| . foobarproc0) procedure)
131        ((|| . foobarproc1) procedure a)
132        ((|| . foobarproc2) procedure a b)
133        ((|| . foobarprocn) procedure a b . r)
134        ((|| . foobarprocx) procedure a b c))
135      (apropos-information-list 'foobarproc #:macros? #t #:qualified? #t #:sort #:module)) ) )
136
137#| ;UNSUPPORTED
138;;
139
140(use environments)
141
142(define tstenv1 (make-environment #t))
143
144(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
145(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
146(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
147(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
148(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))
149
150;make-environment cannot create a syntax-environment
151;apropos always uses the ##sys#macro-environment for macro lookup
152
153(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
154      (apropos-list 'foo tstenv1 #:qualified? #t))
155|#
156
157;;;
158
159(test-end "Apropos")
160
161(test-exit)
Note: See TracBrowser for help on using the repository browser.