source: project/release/4/apropos/trunk/tests/apropos-test.scm @ 34868

Last change on this file since 34868 was 34868, checked in by Kon Lovett, 4 years ago

add interning switch

File size: 3.8 KB
Line 
1(use apropos)
2(use test)
3
4;;
5
6(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
7(define (car-symbol<? a b) (symbol<? (car a) (car b)))
8(define (cdar-symbol<? a b) (symbol<? (cdar a) (cdar b)))
9
10;;;
11
12(test-begin "apropos")
13
14;; build test symbols
15
16(define (foobarproc0) 'foobarproc0)
17(define (foobarproc1 a) 'foobarproc1)
18(define (foobarproc2 a b) 'foobarproc2)
19(define (foobarprocn a b . r) 'foobarprocn)
20
21(define foobarprocx (lambda (a b c) 'foobarprocx))
22
23;RQRD due to use of macro identifiers
24(declare (compile-syntax))
25
26(define-syntax (foobarmacro1 f r c)
27  'foobarmacro1 )
28
29(define-syntax foobarmacro2
30  (syntax-rules ()
31    ((_) 'foobarmacro1 ) ) )
32
33(define foobarvar1 'foobarvar1)
34(define foobarvar2 'foobarvar2)
35
36(define Foobarvar1 'Foobarvar1)
37(define Foobarvar2 'Foobarvar2)
38
39#;(define (foocoreinline flag) (##core#inline "C_set_gc_report" flag))
40#;(define fooprimitive (##core#primitive "C_get_memory_info"))
41
42(define ##foo#bar1 '##foo#bar1)
43(define ##foo#bar2 (lambda () '##foo#bar2))
44
45(define ##bar#foo1 '##bar#foo1)
46(define ##bar#foo2 (lambda () '##bar#foo2))
47
48;; test for symbols
49
50(define (apropos-list-test lst val)
51  (test "apropos-list" (sort lst symbol<?) (sort val symbol<?)) )
52
53(apropos-list-test
54  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
55  (apropos-list 'foobar))
56(apropos-list-test
57  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0)
58  (apropos-list "foobar"))
59(apropos-list-test
60  '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2)
61  (apropos-list 'foo #:macros? #t #:qualified? #t))
62(apropos-list-test
63  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 foobarmacro1 foobarmacro2)
64  (apropos-list 'foobar #:macros? #t))
65(apropos-list-test
66  '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 Foobarvar2 Foobarvar1)
67  (apropos-list 'foobar #:case-insensitive? #t))
68(apropos-list-test
69  '(foobarvar2 foobarvar1 Foobarvar1 Foobarvar2)
70  (apropos-list ''".+barvar[12]"))
71
72(define (apropos-information-list-test lst val)
73  (test "apropos-information-list" (sort lst cdar-symbol<?) (sort val cdar-symbol<?)) )
74
75#; ;not using interned symbols anymore
76(cond-expand
77  (compiling
78    ;reads (|| . foobarmacro1) as ( . foobarmacro1) - whatever the car is i don't know
79    )
80  (else
81    (apropos-information-list-test
82      '(((|| . foobarmacro1) . macro)
83        ((|| . foobarmacro2) . macro)
84        ((|| . foobarproc0) procedure)
85        ((|| . foobarproc1) procedure a)
86        ((|| . foobarproc2) procedure a b)
87        ((|| . foobarprocn) procedure a b . r)
88        ((|| . foobarprocx) procedure a b c)
89        ((|| . foobarvar1) . variable)
90        ((|| . foobarvar2) . variable) )
91      (apropos-information-list 'foobar #:macros? #t #:qualified? #t))
92    (apropos-information-list-test
93      '(((|| . foobarprocx) procedure a b c)
94        ((|| . foobarprocn) procedure a b . r)
95        ((|| . foobarproc2) procedure a b)
96        ((|| . foobarproc1) procedure a)
97        ((|| . foobarproc0) procedure))
98      (apropos-information-list 'foobarproc #:macros? #t #:qualified? #t)) ) )
99
100#| ;UNSUPPORTED
101;;
102
103(use environments)
104
105(define tstenv1 (make-environment #t))
106
107(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
108(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
109(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
110(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
111(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))
112
113;make-environment cannot create a syntax-environment
114;apropos always uses the ##sys#macro-environment for macro lookup
115
116(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
117      (apropos-list 'foo tstenv1 #:qualified? #t))
118|#
119
120(test-end)
121
122;;;
123
124(test-exit)
Note: See TracBrowser for help on using the repository browser.