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

Last change on this file since 37095 was 37095, checked in by kon, 6 months ago

fix #1578, add internal kwd arg, add split test

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