Changeset 37662 in project


Ignore:
Timestamp:
06/09/19 01:27:29 (8 days ago)
Author:
kon
Message:

unsafe test is not default, add test gloss facility

Location:
release/5/bloom-filter/trunk/tests
Files:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/bloom-filter/trunk/tests/bloom-filter-test.scm

    r36959 r37662  
    33
    44(import test)
     5
     6(include "test-gloss.incl")
     7
     8;;
    59
    610(test-begin "Bloom Filter")
     
    1620  (only (chicken pretty-print) pp)
    1721  (only (chicken string) ->string)
    18   (only (chicken format) format)
    1922  (only (chicken random) pseudo-random-integer)
    2023  (only (srfi 1) map! every filter list-copy)
     
    4851      (lambda () (read-list inp reader max))
    4952      (lambda () (unless (input-port? inp-or-fil) (close-input-port inp)) ) ) ) )
    50 
    51 ;;
    52 
    53 ;FIXME needs to "associate" w/ most relevant test item
    54 (define gloss)
    55 (define dump-gloss)
    56 (let ((+glosses+ '()))
    57   ;
    58   (set! gloss (lambda (obj)
    59     (print "Gloss: " obj)
    60     #;(set! +glosses+ (cons (->string obj) +glosses+)) ) )
    61   ;
    62   (set! dump-gloss (lambda ()
    63     #;(print ":Gloss:") #;(pp +glosses+)
    64     (void) ) ) )
    65 
    66 (define (glossf fmt . args)
    67   (gloss (apply format #f fmt args)) )
    6853
    6954;;;
     
    153138  "sj"
    154139  "wolf"))
     140
     141;;
     142
     143(define test-word-list (read-file "bloom-filter-word-list.txt"))
     144(define mirrored-word-list (map string-reverse test-word-list))
     145
    155146#; ;Compute above from word file
    156147(define palindromic-word-list
    157148  (begin
    158149    (import (srfi 69))
    159     (let* ((word-list (read-file "bloom-filter-word-list.txt"))
    160            (word-tbl (alist->hash-table (map (cut cons <> #t) word-list)))
    161            (other-word-list (map string-reverse word-list)) )
     150    (let ((word-tbl (alist->hash-table (map (cut cons <> #t) test-word-list))))
    162151      (foldl
    163152        (lambda (ls wrd)
    164153          (if (hash-table-exists? word-tbl wrd) (cons wrd ls) ls) )
    165154        '()
    166         other-word-list))))
     155        mirrored-word-list))))
    167156
    168157(define-syntax test-success
     
    173162      (test-assert ?mesg (begin ?expr #t)) ) ) )
    174163
    175 (test-begin "Bloom Filter")
    176 
    177 (define word-list (read-file "bloom-filter-word-list.txt"))
    178 
    179164;Shuffle the Hashers
    180165(set! mdps (shuffle mdps))
    181166
    182 (gloss (map message-digest-primitive-name mdps))
    183 
    184 (define N (length word-list))
    185 (define other-word-list (map string-reverse word-list))
     167(gloss)
     168(glossf "digests: ~A" (map message-digest-primitive-name mdps))
     169
     170(define N (length test-word-list))
    186171(define P 2.47E-05)
    187172
     
    195180    (set! MK (receive (optimum-size P N)))
    196181    (glossf "N = ~A, M = ~A, K = ~A, P = ~A" N (car MK) (cadr MK) P)
    197 
    198182    (test-success "Make"
    199183      (set! bf (make-bloom-filter P N mdps)))
    200 
    201184    (test-success "Add Bloom Filter"
    202       (for-each (cut bloom-filter-set! bf <>) word-list))
    203 
     185      (for-each (cut bloom-filter-set! bf <>) test-word-list))
    204186    (test-assert "Exists in Bloom Filter?"
    205       (every (cut bloom-filter-exists? bf <>) word-list))
     187      (every (cut bloom-filter-exists? bf <>) test-word-list))
    206188
    207189    (test-success "False positives"
    208190      (set! false-positives
    209         (filter (cut bloom-filter-exists? bf <>) other-word-list)))
    210 
     191        (filter (cut bloom-filter-exists? bf <>) mirrored-word-list)))
    211192    (glossf "Calced Palindromic words: ~A" (sort false-positives string<?))
    212193    (glossf "Actual Palindromic words: ~A" palindromic-word-list)
     194
    213195    (test (length palindromic-word-list) (length false-positives))
    214196  ) )
     
    233215    (test-success "Make"
    234216      (set! bf (make-bloom-filter (car MKP) mdps)))
    235 
    236217    (test-success "Add Bloom Filter"
    237       (for-each (cut bloom-filter-set! bf <>) word-list))
    238 
     218      (for-each (cut bloom-filter-set! bf <>) test-word-list))
    239219    (test-assert "Exists in Bloom Filter?"
    240       (every (cut bloom-filter-exists? bf <>) word-list))
    241 
    242     ;#;
     220      (every (cut bloom-filter-exists? bf <>) test-word-list))
     221
    243222    (test-success "False positives"
    244223      (set! false-positives
    245         (filter (cut bloom-filter-exists? bf <>) other-word-list)))
    246 
    247     ;"enola" crops up sometimes ?
     224        (filter (cut bloom-filter-exists? bf <>) mirrored-word-list)))
     225    ;"FIXME enola" crops up sometimes ?
    248226    (glossf "Calced Palindromic words: ~A" (sort false-positives string<?))
    249227    (glossf "Actual Palindromic words: ~A" palindromic-word-list)
     228
    250229    (test (length palindromic-word-list) (length false-positives))
    251230  ) )
     
    259238    (set! MKP (receive (desired-m P N)))
    260239    (glossf "N = ~A, M = ~A, K = ~A, P = ~A" N (car MKP) (cadr MKP) (caddr MKP))
     240
    261241    (test-success "Make"
    262242      (set! bf (make-bloom-filter (car MKP) mdps (cadr MKP))))
    263243    (test-success "Add Bloom Filter"
    264       (for-each (cut bloom-filter-set! bf <>) word-list))
     244      (for-each (cut bloom-filter-set! bf <>) test-word-list))
    265245    (test-assert "Exists in Bloom Filter?"
    266       (every (cut bloom-filter-exists? bf <>) word-list))
     246      (every (cut bloom-filter-exists? bf <>) test-word-list))
     247
    267248    (test-success "False positives"
    268249      (set! false-positives
    269         (filter (cut bloom-filter-exists? bf <>) other-word-list)))
    270 
     250        (filter (cut bloom-filter-exists? bf <>) mirrored-word-list)))
    271251    (glossf "Calced Palindromic words: ~A" (sort false-positives string<?))
    272252    (glossf "Actual Palindromic words: ~A" palindromic-word-list)
     253
    273254    (test (length palindromic-word-list) (length false-positives))
    274255) )
    275256
    276 (dump-gloss)
    277 
    278257;;;
    279258
  • release/5/bloom-filter/trunk/tests/run.scm

    r36232 r37662  
    1515(define *csc-options* "-inline-global \
    1616  -specialize -optimize-leaf-routines -clustering -lfa2 \
    17   -local -inline \
    18   -no-trace -no-lambda-info \
    19   -unsafe")
     17  -local -inline")
    2018
    2119(define (test-name #!optional (eggnam EGG-NAME))
Note: See TracChangeset for help on using the changeset viewer.