- Timestamp:
- 04/18/20 16:14:31 (9 months ago)
- Location:
- release/5/apropos/trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/5/apropos/trunk/apropos-api.scm
r38625 r38628 176 176 ;; Environment Search 177 177 178 (define (*apropos-list/macro-environment loc match? macenv)179 (search-macro-environment-symbols match? macenv) )180 181 (define (*apropos-list/environment loc match? env)182 (search-system-environment-symbols match? env) )183 184 178 ;; 185 179 … … 190 184 (if (or (not nxt) (null? nxt)) 191 185 ols 192 (if (eql? (car ls) (car nxt))186 (if (eql? ls nxt) 193 187 (begin 194 188 (set-cdr! ls (cdr nxt)) 195 189 (loop ls) ) 196 190 (loop nxt) ) ) ) ) ) 191 192 (define (*apropos-list/macro-environment loc match? macenv) 193 (import (only (chicken sort) sort!)) 194 ;FIXME why macro symbol dups? (& they are dups - assq list w/ dups) 195 (delete-duplicates!/sorted 196 (sort! (search-macro-environment-symbols match? macenv) symbol-printname<?) 197 (lambda (a b) (eq? (car a) (car b)))) ) 198 199 (define (*apropos-list/environment loc match? env) 200 (search-system-environment-symbols match? env) ) 197 201 198 202 ; => (envsyms . macenvsyms) … … 201 205 (*apropos-list/environment loc match/env? env) 202 206 (if macenv 203 ;FIXME why macro symbol dups? 204 (let ((syms (*apropos-list/macro-environment loc match/macenv? macenv))) 205 (import (only (chicken sort) sort!)) 206 (delete-duplicates!/sorted (sort! syms symbol-printname<?) eq?) ) 207 (*apropos-list/macro-environment loc match/macenv? macenv) 207 208 '())) ) 208 209 -
release/5/apropos/trunk/apropos.egg
r38625 r38628 5 5 6 6 ((synopsis "CHICKEN apropos") 7 (version "3.5. 0")7 (version "3.5.1") 8 8 (category misc) 9 9 (author "[[kon lovett]]") … … 19 19 (extension symbol-table-access 20 20 (types-file) 21 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") )21 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) 22 22 (extension symbol-access 23 23 (types-file) 24 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") )24 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) 25 25 (extension symbol-environment-access 26 26 (types-file) 27 27 (component-dependencies symbol-table-access) 28 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") )28 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) 29 29 (extension apropos-api 30 30 (types-file) 31 31 (component-dependencies symbol-access symbol-environment-access) 32 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") )32 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) 33 33 (extension apropos-csi 34 34 (types-file) 35 35 (component-dependencies apropos-api) 36 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") )36 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) 37 37 (extension apropos 38 38 (types-file) 39 39 (component-dependencies apropos-csi apropos-api) 40 (csc-options "-O3" "-d1" "- local" "-no-procedure-checks" "-no-bound-checks") ) ) )40 (csc-options "-O3" "-d1" "-strict-types" "-no-procedure-checks" "-no-bound-checks") ) ) ) -
release/5/apropos/trunk/tests/apropos-test.scm
r38405 r38628 18 18 (define (cdar-symbol<? a b) (symbol<? (cdar a) (cdar b))) 19 19 20 ;;; 20 (define-syntax *apropos-list-test 21 (syntax-rules () 22 ((apropos-list-test ?msg ?lst ?val ?less?) 23 (test ?msg (sort ?lst ?less?) (sort ?val ?less?)) ) ) ) 24 25 (define-syntax apropos-list-test 26 (syntax-rules () 27 ; 28 ((apropos-list-test ?lst ?val) 29 (apropos-list-test "apropos-list" ?lst ?val) ) 30 ; 31 ((apropos-list-test ?msg ?lst ?val) 32 (*apropos-list-test ?msg ?lst ?val symbol<?) ) ) ) 33 34 (define-syntax apropos-information-list-test 35 (syntax-rules () 36 ; 37 ((apropos-information-list-test ?lst ?val) 38 (apropos-information-list-test "apropos-information-list" ?lst ?val) ) 39 ; 40 ((apropos-information-list-test ?msg ?lst ?val) 41 (*apropos-list-test ?msg ?lst ?val cdar-symbol<?) ) ) ) 42 43 ;; 44 45 (test-group "Imported" 46 (cond-expand 47 (csi 48 ;tests wildcard module but restricts to just imported 49 (apropos-list-test "test w/ imported?: #t" 50 '(test#current-test-group test#test-exit test#test-run 51 test#current-test-applier test#current-test-handler 52 test#current-test-verbosity test#test-total-count test#test-group-inc! 53 test#current-test-epsilon test#current-test-group-reporter 54 test#test-failure-count test#test-end test#current-test-skipper 55 test#test-begin test#current-test-comparator) 56 ;NOTE module+identifier pattern syntax has ' as lead tag so an evaluated arg 57 ;must be quoted 58 (apropos-list ''(_ . test) #:imported? #t)) ) 59 (else 60 ;(almost) nothing imported so specify module & check the oblist 61 (apropos-list-test "test w/ specific module" 62 '(test#current-test-group test#test-exit test#test-run 63 test#current-test-applier test#current-test-handler 64 test#current-test-verbosity test#test-total-count test#test-group-inc! 65 test#current-test-epsilon test#current-test-group-reporter 66 test#test-failure-count test#test-end test#current-test-skipper 67 test#test-begin test#current-test-comparator) 68 ;NOTE module+identifier pattern syntax has ' as lead tag so an evaluated arg 69 ;must be quoted 70 (apropos-list ''(test . test))) ) ) 71 ) 21 72 22 73 ;; build test symbols … … 58 109 ;; test for symbols 59 110 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<?)) ) 111 (test-group "Symbol List" 112 113 (apropos-list-test 114 '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0) 115 (apropos-list 'foobar)) 116 117 (apropos-list-test 118 '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0) 119 (apropos-list "foobar")) 120 121 (apropos-list-test 122 '(##bar#foo1 ##bar#foo2 foobarmacro1 foobarmacro2 foobarproc0 foobarproc1 foobarproc2 foobarprocn foobarprocx foobarvar1 foobarvar2) 123 (apropos-list 'foo #:macros? #t #:internal? #t #:split #:name)) 124 125 (apropos-list-test 126 '(##foo#bar1 ##foo#bar2) 127 (apropos-list 'foo #:macros? #t #:internal? #t #:split #:module)) 128 129 (apropos-list-test 130 '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 foobarmacro1 foobarmacro2) 131 (apropos-list 'foobar #:macros? #t)) 132 133 (apropos-list-test 134 '(foobarvar2 foobarvar1 foobarprocx foobarprocn foobarproc2 foobarproc1 foobarproc0 Foobarvar2 Foobarvar1) 135 (apropos-list 'foobar #:case-insensitive? #t)) 136 137 (apropos-list-test 138 '(foobarvar2 foobarvar1 Foobarvar1 Foobarvar2) 139 (apropos-list ''".+barvar[12]")) 140 ) 141 142 ;; 95 143 96 144 #| … … 117 165 ;oh , my - #:|| from reader is not eq? #:|| from symbol-table 118 166 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)) 167 (test-group "Information List" 168 (apropos-information-list-test 169 '( 170 ((|| . foobarmacro1) . macro) 171 ((|| . foobarmacro2) . macro) 172 ((|| . foobarproc0) procedure) 173 ((|| . foobarproc1) procedure a) 174 ((|| . foobarproc2) procedure a b) 175 ((|| . foobarprocn) procedure a b . r) 176 ((|| . foobarprocx) procedure a b c) 177 ((|| . foobarvar1) . variable) 178 ((|| . foobarvar2) . variable) ) 179 (apropos-information-list 'foobar #:macros? #t #:internal? #t)) 180 181 (test "apropos-information-list" 182 '(((|| . foobarproc0) procedure) 183 ((|| . foobarproc1) procedure a) 184 ((|| . foobarproc2) procedure a b) 185 ((|| . foobarprocn) procedure a b . r) 186 ((|| . foobarprocx) procedure a b c)) 187 (apropos-information-list 'foobarproc #:macros? #t #:internal? #t #:sort #:module)) 188 ) 138 189 139 190 #| ;UNSUPPORTED
Note: See TracChangeset
for help on using the changeset viewer.