Changeset 37953 in project


Ignore:
Timestamp:
10/09/19 20:55:28 (10 days ago)
Author:
Kon Lovett
Message:

add test dependencies, reflow

Location:
release/5/bloom-filter/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/5/bloom-filter/trunk/bloom-filter.egg

    r36748 r37953  
    44((synopsis "Bloom Filter")
    55 (category data)
    6  (version "2.2.1")
     6 (version "2.2.2")
    77 (author "[[kon lovett]]")
    88 (license "BSD")
     
    1313        (message-digest-utils "4.1.1")
    1414        (check-errors "3.1.0"))
    15  (test-dependencies test sha1 sha2 md5 tiger-hash ripemd)
     15 (test-dependencies test srfi-1 srfi-13 sha1 sha2 md5 tiger-hash ripemd)
    1616 (components
    1717  (extension bloom-filter
  • release/5/bloom-filter/trunk/tests/bloom-filter-test.scm

    r37662 r37953  
    1414(import scheme
    1515  (chicken base)
     16  (chicken type)
    1617  (chicken syntax)
    17   (chicken fixnum)
    18   (chicken io)
    19   (only (chicken sort) sort! sort)
    20   (only (chicken pretty-print) pp)
    21   (only (chicken string) ->string)
    22   (only (chicken random) pseudo-random-integer)
    23   (only (srfi 1) map! every filter list-copy)
     18  ;(chicken fixnum)
     19  (only (chicken sort) sort)
     20  ;(only (chicken pretty-print) pp)
     21  ;(only (chicken string) ->string)
     22  (only (srfi 1) every filter list-copy)
    2423  (only (srfi 13) string-reverse)
    2524  message-digest-primitive
     
    3029;;
    3130
     31(import
     32  (only (chicken fixnum) most-positive-fixnum fx<)
     33  (only (srfi 1) map!)
     34  (only (chicken sort) sort!)
     35  (only (chicken random) pseudo-random-integer))
     36
    3237(: shuffle ((list-of *) #!optional (procedure (fixnum) fixnum) -> (list-of *)))
    3338;
    3439(define (shuffle ls #!optional (rand pseudo-random-integer))
    35     ;
    36     (define (tag-gen) (rand most-positive-fixnum))
    37     (define (tag-rnd x) (cons (tag-gen) x))
    38     (define (tag< x y) (fx< (car x) (car y)))
    39     ;
    40     (map! cdr (sort! (map tag-rnd ls) tag<)) )
     40  (define (tag-gen) (rand most-positive-fixnum))
     41  (define (tag-rnd x) (cons (tag-gen) x))
     42  (define (tag< x y) (fx< (car x) (car y)))
     43  (map! cdr (sort! (map tag-rnd ls) tag<)) )
    4144
    4245;;
     
    4548;
    4649(define (read-file inp-or-fil #!optional (reader read) max)
     50  (import (chicken io))
    4751  (let (
    4852    (inp (if (input-port? inp-or-fil) inp-or-fil (open-input-file inp-or-fil))) )
     
    5155      (lambda () (read-list inp reader max))
    5256      (lambda () (unless (input-port? inp-or-fil) (close-input-port inp)) ) ) ) )
     57
     58;;
     59
     60(define-syntax test-success
     61  (syntax-rules ()
     62    ((test-success ?expr)
     63      (test-assert (begin ?expr #t)) )
     64    ((test-success ?mesg ?expr)
     65      (test-assert ?mesg (begin ?expr #t)) ) ) )
    5366
    5467;;;
     
    155168        mirrored-word-list))))
    156169
    157 (define-syntax test-success
    158   (syntax-rules ()
    159     ((test-success ?expr)
    160       (test-assert (begin ?expr #t)) )
    161     ((test-success ?mesg ?expr)
    162       (test-assert ?mesg (begin ?expr #t)) ) ) )
    163 
    164170;Shuffle the Hashers
    165171(set! mdps (shuffle mdps))
     
    171177(define P 2.47E-05)
    172178
    173 (let ((MK #f)
    174       (bf #f)
    175       (false-positives '()) )
     179(let (
     180  (MK #f)
     181  (bf #f)
     182  (false-positives '()) )
    176183
    177184  (test-group "Words In List, All K"
     
    194201
    195202    (test (length palindromic-word-list) (length false-positives))
    196   ) )
    197 
    198 (let ((MKP* #f)
    199       (MKP #f)
    200       (bf #f)
    201       (false-positives '()) )
     203) )
     204
     205(let (
     206  (MKP* #f)
     207  (MKP #f)
     208  (bf #f)
     209  (false-positives '()) )
    202210
    203211  (test-group "Words In List, Actual K"
     
    228236
    229237    (test (length palindromic-word-list) (length false-positives))
    230   ) )
    231 
    232 (let ((MKP #f)
    233       (bf #f)
    234       (false-positives '()) )
     238) )
     239
     240(let (
     241  (MKP #f)
     242  (bf #f)
     243  (false-positives '()) )
    235244
    236245  (test-group "Words In List, Optimal K"
  • release/5/bloom-filter/trunk/tests/test-gloss.incl.scm

    r37674 r37953  
    22;;;test "Gloss" API
    33
    4 (define (assq-ref ls key . o)
    5   (cond ((assq key ls) => cdr)
    6         ((pair? o) (car o))
    7         (else #f)))
     4(import (only (chicken base) case-lambda))
     5
     6(define-constant *test-gloss-marker* "--> ")
    87
    98(define (test-group-ref group field . o)
    10   (apply assq-ref (cdr group) field o))
     9  (define (assq-ref ls key . o)
     10    (cond
     11      ((assq key ls)    => cdr)
     12      ((pair? o)        (car o))
     13      (else             #f) ) )
     14  (apply assq-ref (cdr group) field o) )
    1115
    12 (begin
    13   (import (chicken process-context))
    14   (define *test-indent-width*
    15     (or (cond ((get-environment-variable "TEST_INDENT_WIDTH") => string->number) (else #f))
    16         4))
    17   (define *test-first-indentation*
    18     (or (cond ((get-environment-variable "TEST_FIRST_INDENTATION") => string->number) (else #f))
    19         1))
    20   (define *test-max-indentation*
    21     (or (cond ((get-environment-variable "TEST_MAX_INDENTATION") => string->number) (else #f))
    22         5)))
     16(define test-indent-width)
     17(define test-first-indentation)
     18(define test-max-indentation)
     19(define test-indentation-char)
     20(let ()
     21  (import
     22    (chicken syntax)
     23    (only (chicken process-context) get-environment-variable))
    2324
    24 (define test-indent-width (lambda () *test-indent-width*))
    25 (define test-first-indentation (lambda () *test-first-indentation*))
    26 (define test-max-indentation (lambda () *test-max-indentation*))
     25  (define get-environment-variable/default
     26    (case-lambda
     27      ((nm)
     28        (get-environment-variable/default nm #f))
     29      ((nm def)
     30        (cond
     31          ((get-environment-variable nm) => string->number)
     32          (else                           def))) ) )
    2733
    28 (define (test-group-indent-width group)
    29   (let ((level (max 0 (+ 1 (- (test-group-ref group 'level 0)
    30                               (test-first-indentation))))))
    31     (* (test-indent-width) (min level (test-max-indentation)))))
     34  ;from miscmacros
     35
     36  (define-syntax define-parameter
     37    (syntax-rules ()
     38      ((define-parameter name value guard)
     39       (define name (make-parameter value guard)))
     40      ((define-parameter name value)
     41       (define name (make-parameter value)))
     42      ((define-parameter name)
     43       (define name (make-parameter (void))))))
     44
     45  ;from moremacros
     46
     47  (import-for-syntax (only (chicken string) conc))
     48
     49  ; maybe a problem with expansion environment namespace pollution
     50  (define-for-syntax (make-identifier . elts)
     51    (string->symbol (apply conc (map strip-syntax elts))) )
     52
     53  (define-syntax checked-guard
     54    (er-macro-transformer
     55      (lambda (frm rnm cmp)
     56        (##sys#check-syntax 'checked-guard frm '(_ symbol symbol . _))
     57        (let (
     58          (?locnam (cadr frm))
     59          (?typnam (caddr frm))
     60          (?body (cdddr frm))
     61          (_lambda (rnm 'lambda)) )
     62          `(,_lambda (obj)
     63            (,(make-identifier "check-" (symbol->string ?typnam)) ',?locnam obj)
     64            ,@?body
     65            obj ) ) ) ) )
     66
     67  ;from check-errors
     68
     69  (define (positive-integer? obj) (and (integer? obj) (positive? obj)))
     70
     71  (define (check-positive-integer loc obj)
     72    (unless (positive-integer? obj) (error loc "not a positive-integer" obj))
     73    obj )
     74
     75  (define (check-char loc obj)
     76    (unless (char? obj) (error loc "not a char" obj))
     77    obj )
     78
     79  (set! test-indent-width
     80    (make-parameter
     81      (get-environment-variable/default "TEST_INDENT_WIDTH" 4)
     82      (checked-guard test-indent-width positive-integer)))
     83  (set! test-first-indentation
     84    (make-parameter
     85      (get-environment-variable/default "TEST_FIRST_INDENTATION" 1)
     86      (checked-guard test-first-indentation positive-integer)))
     87  (set! test-max-indentation
     88    (make-parameter
     89      (get-environment-variable/default "TEST_MAX_INDENTATION" 5)
     90      (checked-guard test-max-indentation positive-integer)))
     91  (set! test-indentation-char
     92    (make-parameter
     93      (string-ref (get-environment-variable/default "TEST_INDENTATION_CHAR" " ") 0)
     94      (checked-guard test-indentation-char char))) )
    3295
    3396(define (test-group-indent-string group)
    34   (make-string (test-group-indent-width group) #\space) )
    35 
    36 (define-constant *test-gloss-marker* "--> ")
     97  (define (*test-group-level group)
     98    (add1 (- (test-group-ref group 'level 0) (test-first-indentation))) )
     99  (define (test-group-level group)
     100    (min (test-max-indentation) (max 0 (*test-group-level group))) )
     101  (define (test-group-indent-width group)
     102    (* (test-indent-width) (test-group-level group)) )
     103  (make-string (test-group-indent-width group) (test-indentation-char)) )
    37104
    38105(define gloss
     
    41108      (newline))
    42109    ((obj)
    43       (print (test-group-indent-string (current-test-group)) *test-gloss-marker* obj))))
     110      (print (test-group-indent-string (current-test-group)) *test-gloss-marker* obj)) ) )
    44111
    45112(define (glossf fmt . args)
Note: See TracChangeset for help on using the changeset viewer.