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

Last change on this file since 38405 was 38405, checked in by Kon Lovett, 6 months ago

type-checks obviate compiler procedure & bounds checks since duplicate work

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 (chicken syntax))
11(import (chicken sort))
12(import apropos-api)
13
14;;
15
16(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
17(define (car-symbol<? a b) (symbol<? (car a) (car b)))
18(define (cdar-symbol<? a b) (symbol<? (cdar a) (cdar b)))
19
20;;;
21
22;; build test symbols
23
24(define (foobarproc0) 'foobarproc0)
25(define (foobarproc1 a) 'foobarproc1)
26(define (foobarproc2 a b) 'foobarproc2)
27(define (foobarprocn a b . r) 'foobarprocn)
28
29(define foobarprocx (lambda (a b c) 'foobarprocx))
30
31;RQRD due to use of macro identifiers
32(declare (compile-syntax))
33
34(define-syntax foobarmacro1
35  (er-macro-transformer
36    (lambda (f r c)
37      'foobarmacro1 ) ) )
38
39(define-syntax foobarmacro2
40  (syntax-rules ()
41    ((_) 'foobarmacro1 ) ) )
42
43(define foobarvar1 'foobarvar1)
44(define foobarvar2 'foobarvar2)
45
46(define Foobarvar1 'Foobarvar1)
47(define Foobarvar2 'Foobarvar2)
48
49#;(define (foocoreinline flag) (##core#inline "C_set_gc_report" flag))
50#;(define fooprimitive (##core#primitive "C_get_memory_info"))
51
52(define ##foo#bar1 '##foo#bar1)
53(define ##foo#bar2 (lambda () '##foo#bar2))
54
55(define ##bar#foo1 '##bar#foo1)
56(define ##bar#foo2 (lambda () '##bar#foo2))
57
58;; test for symbols
59
60(define (apropos-list-test lst val)
61  (test "apropos-list" (sort lst symbol<?) (sort val symbol<?)) )
62
63(apropos-list-test
64  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
65  (apropos-list 'foobar))
66
67(apropos-list-test
68  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
69  (apropos-list "foobar"))
70
71(apropos-list-test
72  '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2)
73  (apropos-list 'foo #:macros? #t #:internal? #t #:split #:name))
74
75(apropos-list-test
76  '(##foo#bar1 ##foo#bar2)
77  (apropos-list 'foo #:macros? #t #:internal? #t #:split #:module))
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;oh , my - #:|| from reader is not eq? #:|| from symbol-table
118
119(apropos-information-list-test
120  '(
121    ((|| . foobarmacro1) . macro)
122    ((|| . foobarmacro2) . macro)
123    ((|| . foobarproc0) procedure)
124    ((|| . foobarproc1) procedure a)
125    ((|| . foobarproc2) procedure a b)
126    ((|| . foobarprocn) procedure a b . r)
127    ((|| . foobarprocx) procedure a b c)
128    ((|| . foobarvar1) . variable)
129    ((|| . foobarvar2) . variable) )
130  (apropos-information-list 'foobar #:macros? #t #:internal? #t))
131(test "apropos-information-list"
132  '(((|| . foobarproc0) procedure)
133    ((|| . foobarproc1) procedure a)
134    ((|| . foobarproc2) procedure a b)
135    ((|| . foobarprocn) procedure a b . r)
136    ((|| . foobarprocx) procedure a b c))
137  (apropos-information-list 'foobarproc #:macros? #t #:internal? #t #:sort #:module))
138
139#| ;UNSUPPORTED
140;;
141
142(use environments)
143
144(define tstenv1 (make-environment #t))
145
146(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
147(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
148(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
149(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
150(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))
151
152;make-environment cannot create a syntax-environment
153;apropos always uses the ##sys#macro-environment for macro lookup
154
155(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
156      (apropos-list 'foo tstenv1 #:internal? #t))
157|#
158
159;;;
160
161(test-end "Apropos")
162
163(test-exit)
Note: See TracBrowser for help on using the repository browser.