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

Last change on this file since 37049 was 37049, checked in by kon, 4 months ago

rm qualified refs

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-api)
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
70(apropos-list-test
71  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
72  (apropos-list "foobar"))
73
74#;
75(apropos-list-test
76  '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2)
77  (apropos-list 'foo #:macros? #t))
78
79(apropos-list-test
80  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 foobarmacro1 foobarmacro2)
81  (apropos-list 'foobar #:macros? #t))
82
83(apropos-list-test
84  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 Foobarvar2 Foobarvar1)
85  (apropos-list 'foobar #:case-insensitive? #t))
86
87(apropos-list-test
88  '(foobarvar2 foobarvar1 Foobarvar1 Foobarvar2)
89  (apropos-list ''".+barvar[12]"))
90
91;;
92
93(define (apropos-information-list-test lst val)
94  (test "apropos-information-list" (sort lst cdar-symbol<?) (sort val cdar-symbol<?)) )
95
96#|
97#;14> (define foobarprocx (lambda (a b c) 'foobarprocx))
98#;15> '(((|| . foobarmacro1) . macro))
99(((||: . foobarmacro1) . macro))
100#;16> '(((||: . foobarmacro1) . macro))
101(((: . foobarmacro1) . macro))
102#;17> ||
103||:
104#;18> ||:
105
106Error: unbound variable: :
107#;19> #:||
108||:
109#;20> (eq? #:|| #:||)
110#t
111#;21> (caaar (apropos-information-list 'foobarproc))
112||:
113#;22> (eq? #:|| (caaar (apropos-information-list 'foobarproc)))
114#f
115|#
116
117(cond-expand
118  (compiling
119    ;reads (|| . foobarmacro1) as ( . foobarmacro1)
120    )
121  (else
122    ;oh , my : #:|| from reader is not eq? #:|| from symbol-table
123    (apropos-information-list-test
124      '(
125        ((|| . foobarmacro1) . macro)
126        ((|| . foobarmacro2) . macro)
127        ((|| . foobarproc0) procedure)
128        ((|| . foobarproc1) procedure a)
129        ((|| . foobarproc2) procedure a b)
130        ((|| . foobarprocn) procedure a b . r)
131        ((|| . foobarprocx) procedure a b c)
132        ((|| . foobarvar1) . variable)
133        ((|| . foobarvar2) . variable) )
134      (apropos-information-list 'foobar #:macros? #t))
135    (test "apropos-information-list"
136      '(((|| . foobarproc0) procedure)
137        ((|| . foobarproc1) procedure a)
138        ((|| . foobarproc2) procedure a b)
139        ((|| . foobarprocn) procedure a b . r)
140        ((|| . foobarprocx) procedure a b c))
141      (apropos-information-list 'foobarproc #:macros? #t #:sort #:module)) ) )
142
143#| ;UNSUPPORTED
144;;
145
146(use environments)
147
148(define tstenv1 (make-environment #t))
149
150(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
151(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
152(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
153(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
154(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))
155
156;make-environment cannot create a syntax-environment
157;apropos always uses the ##sys#macro-environment for macro lookup
158
159(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
160      (apropos-list 'foo tstenv1))
161|#
162
163;;;
164
165(test-end "Apropos")
166
167(test-exit)
Note: See TracBrowser for help on using the repository browser.