Changeset 38628 in project for release


Ignore:
Timestamp:
04/18/20 16:14:31 (4 months ago)
Author:
Kon Lovett
Message:

add test groups, add imported test, remove redundant -local, add strict-types

Location:
release/5/apropos/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/apropos/trunk/apropos-api.scm

    r38625 r38628  
    176176;; Environment Search
    177177
    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 
    184178;;
    185179
     
    190184      (if (or (not nxt) (null? nxt))
    191185        ols
    192         (if (eql? (car ls) (car nxt))
     186        (if (eql? ls nxt)
    193187          (begin
    194188            (set-cdr! ls (cdr nxt))
    195189            (loop ls) )
    196190          (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) )
    197201
    198202; => (envsyms . macenvsyms)
     
    201205    (*apropos-list/environment loc match/env? env)
    202206    (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)
    207208      '())) )
    208209
  • release/5/apropos/trunk/apropos.egg

    r38625 r38628  
    55
    66((synopsis "CHICKEN apropos")
    7  (version "3.5.0")
     7 (version "3.5.1")
    88 (category misc)
    99 (author "[[kon lovett]]")
     
    1919  (extension symbol-table-access
    2020    (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") )
    2222  (extension symbol-access
    2323    (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") )
    2525  (extension symbol-environment-access
    2626    (types-file)
    2727    (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") )
    2929  (extension apropos-api
    3030    (types-file)
    3131    (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") )
    3333  (extension apropos-csi
    3434    (types-file)
    3535    (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") )
    3737  (extension apropos
    3838    (types-file)
    3939    (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  
    1818(define (cdar-symbol<? a b) (symbol<? (cdar a) (cdar b)))
    1919
    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)
    2172
    2273;; build test symbols
     
    58109;; test for symbols
    59110
    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;;
    95143
    96144#|
     
    117165;oh , my - #:|| from reader is not eq? #:|| from symbol-table
    118166
    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)
    138189
    139190#| ;UNSUPPORTED
Note: See TracChangeset for help on using the changeset viewer.