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

Last change on this file since 35060 was 35060, checked in by kon, 8 months ago

oohkeyy , that seems reasonable

File size: 4.0 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;;
73
74(define (apropos-information-list-test lst val)
75  (test "apropos-information-list" (sort lst cdar-symbol<?) (sort val cdar-symbol<?)) )
76
77#|
78#;15> '(((|| . foobarmacro1) . macro))
79(((||: . foobarmacro1) . macro))
80#;16> '(((||: . foobarmacro1) . macro))
81(((: . foobarmacro1) . macro))
82#;17> ||
83||:
84#;18> ||:
85
86Error: unbound variable: :
87#;18> ||
88||:
89|#
90
91(cond-expand
92  (compiling
93    ;reads (|| . foobarmacro1) as ( . foobarmacro1)
94    )
95  (else
96    ;oh , my : #:|| from reader is not eq? #:|| from symbol-table
97    (apropos-information-list-test
98      '(
99        ((|| . foobarmacro1) . macro)
100        ((|| . foobarmacro2) . macro)
101        ((|| . foobarproc0) procedure)
102        ((|| . foobarproc1) procedure a)
103        ((|| . foobarproc2) procedure a b)
104        ((|| . foobarprocn) procedure a b . r)
105        ((|| . foobarprocx) procedure a b c)
106        ((|| . foobarvar1) . variable)
107        ((|| . foobarvar2) . variable) )
108      (apropos-information-list 'foobar #:macros? #t #:qualified? #t))
109    (test "apropos-information-list"
110      '(((|| . foobarproc0) procedure)
111        ((|| . foobarproc1) procedure a)
112        ((|| . foobarproc2) procedure a b)
113        ((|| . foobarprocn) procedure a b . r)
114        ((|| . foobarprocx) procedure a b c))
115      (apropos-information-list 'foobarproc #:macros? #t #:qualified? #t #:sort #:module)) ) )
116
117#| ;UNSUPPORTED
118;;
119
120(use environments)
121
122(define tstenv1 (make-environment #t))
123
124(environment-extend! tstenv1 'foobarprocx (lambda (a b c) 'foobarprocx))
125(environment-extend! tstenv1 'foobarvar1 'foobarvar1)
126(environment-extend! tstenv1 'foobarvar2 'foobarvar2)
127(environment-extend! tstenv1 '##bar#foo1 '##bar#foo1)
128(environment-extend! tstenv1 '##bar#foo1 (lambda () '##bar#foo1))
129
130;make-environment cannot create a syntax-environment
131;apropos always uses the ##sys#macro-environment for macro lookup
132
133(test '(foobarprocx foobarvar2 foobarvar1 ##bar#foo1)
134      (apropos-list 'foo tstenv1 #:qualified? #t))
135|#
136
137(test-end)
138
139;;;
140
141(test-exit)
Note: See TracBrowser for help on using the repository browser.