1: ;;
    2: ;; Test hash table
    3: ;;
    4: 
    5: ;; $Id: hash.scm,v 1.12 2007/04/20 20:49:09 shirok Exp $
    6: 
    7: (use gauche.test)
    8: (use srfi-1)
    9: (use srfi-13)
   10: 
   11: ;; Note: this file tests basic hash table functionarity, and does not
   12: ;; cover the user-extended hash table (which is done by overloading
   13: ;; object-equal? and object-hash).  It is because object system is
   14: ;; tested _after_ this file.  See test/object.scm for extended hash table
   15: ;; test.
   16: 
   17: (test-start "hash tables")
   18: 
   19: ;;------------------------------------------------------------------
   20: (test-section "eq?-hash")
   21: 
   22: (define h-eq (make-hash-table))
   23: 
   24: (test* "make-hash-table" #t
   25:        (hash-table? h-eq))
   26: 
   27: (test* "hash-table-type" 'eq?
   28:        (hash-table-type h-eq))
   29: 
   30: (test* "a => 8" 8
   31:        (begin
   32:          (hash-table-put! h-eq 'a 8)
   33:          (hash-table-get  h-eq 'a)))
   34: 
   35: (test* "b => non" #t
   36:        (hash-table-get  h-eq 'b #t))
   37: 
   38: (test* "b => error" *test-error*
   39:        (hash-table-get h-eq 'b))
   40: 
   41: (test* "b => \"b\"" "b"
   42:        (begin
   43:          (hash-table-put! h-eq 'b "b")
   44:          (hash-table-get  h-eq 'b)))
   45: 
   46: (test* "c => #\C" #\C
   47:        (begin
   48:          (hash-table-put! h-eq 'c #\C)
   49:          (hash-table-get  h-eq 'c)))
   50: 
   51: (test* "c => #\c" #\c
   52:        (begin
   53:          (hash-table-put! h-eq 'c #\c)
   54:          (hash-table-get  h-eq 'c)))
   55: 
   56: (test* "e => 10" 10
   57:        (begin
   58:          (hash-table-put! h-eq 'e 8)
   59:          (hash-table-update! h-eq 'e (lambda (x) (+ x 1)))
   60:          (hash-table-update! h-eq 'e (lambda (x) (+ x 1)))
   61:          (hash-table-get h-eq 'e)))
   62: 
   63: (test* "f => 1" 3
   64:        (begin
   65:          (hash-table-update! h-eq 'f (lambda (x) (+ x 1)) 2)
   66:          (hash-table-get h-eq 'f)))
   67: 
   68: (test* "eq? test" 7
   69:        (begin
   70:          (hash-table-put! h-eq (string #\d) 4)
   71:          (hash-table-put! h-eq (string #\d) 5)
   72:          (length (hash-table-keys h-eq))))
   73: 
   74: (test* "hash-table-values(1)" #t
   75:        (lset= equal? (hash-table-values h-eq) '(8 "b" #\c 3 4 5 10)))
   76: 
   77: (test* "delete!" '(#t #f #f)
   78:        (let* ((a (hash-table-delete! h-eq 'c))
   79:               (b (hash-table-delete! h-eq 'c)))
   80:          (list a b (hash-table-get h-eq 'c #f))))
   81: 
   82: (test* "clear!" '()
   83:        (begin (hash-table-clear! h-eq)
   84:               (hash-table-keys h-eq)))
   85: 
   86: ;;------------------------------------------------------------------
   87: (test-section "eqv?-hash")
   88: 
   89: (define h-eqv (make-hash-table 'eqv?))
   90: 
   91: (test* "make-hash-table" #t
   92:        (hash-table? h-eqv))
   93: 
   94: (test* "hash-table-type" 'eqv?
   95:        (hash-table-type h-eqv))
   96: 
   97: (test* "a => 8" 8
   98:        (begin
   99:          (hash-table-put! h-eqv 'a 8)
  100:          (hash-table-get  h-eqv 'a)))
  101: 
  102: (test* "b => non" #t
  103:        (hash-table-get  h-eqv 'b #t))
  104: 
  105: (test* "b => error" *test-error*
  106:        (hash-table-get  h-eqv 'b))
  107: 
  108: (test* "b => \"b\"" "b"
  109:        (begin
  110:          (hash-table-put! h-eqv 'b "b")
  111:          (hash-table-get  h-eqv 'b)))
  112: 
  113: (test* "2.0 => #\C" #\C
  114:        (begin
  115:          (hash-table-put! h-eqv 2.0 #\C)
  116:          (hash-table-get  h-eqv 2.0)))
  117: 
  118: (test* "2.0 => #\c" #\c
  119:        (begin
  120:          (hash-table-put! h-eqv 2.0 #\c)
  121:          (hash-table-get  h-eqv 2.0)))
  122: 
  123: 
  124: (test* "87592876592374659237845692374523694756 => 0" 0
  125:        (begin
  126:          (hash-table-put! h-eqv 87592876592374659237845692374523694756 0)
  127:          (hash-table-get  h-eqv 87592876592374659237845692374523694756)))
  128: 
  129: (test* "87592876592374659237845692374523694756 => -1" -1
  130:        (begin
  131:          (hash-table-put! h-eqv 87592876592374659237845692374523694756 -1)
  132:          (hash-table-get  h-eqv 87592876592374659237845692374523694756)))
  133: 
  134: (test* "377/120 => pi" 'pi
  135:        (begin
  136:          (hash-table-put! h-eqv 377/120 'pi)
  137:          (hash-table-get  h-eqv 377/120)))
  138: 
  139: (test* "377/120 => PI" 'PI
  140:        (begin
  141:          (hash-table-put! h-eqv 377/120 'PI)
  142:          (hash-table-get  h-eqv 377/120)))
  143: 
  144: (test* "eqv? test" 7
  145:        (begin
  146:          (hash-table-put! h-eqv (string #\d) 4)
  147:          (hash-table-put! h-eqv (string #\d) 5)
  148:          (length (hash-table-keys h-eqv))))
  149: 
  150: (test* "hash-table-values(2)" #t
  151:        (lset= equal? (hash-table-values h-eqv) '(8 "b" #\c -1 4 5 PI)))
  152: 
  153: (test* "delete!" #f
  154:        (begin
  155:          (hash-table-delete! h-eqv 87592876592374659237845692374523694756)
  156:          (hash-table-get h-eqv 87592876592374659237845692374523694756 #f)))
  157: 
  158: ;;------------------------------------------------------------------
  159: (test-section "equal?-hash")
  160: 
  161: (define h-equal (make-hash-table 'equal?))
  162: 
  163: (test* "make-hash-table" #t
  164:        (hash-table? h-equal))
  165: 
  166: (test* "hash-table-type" 'equal?
  167:        (hash-table-type h-equal))
  168: 
  169: (test* "a => 8" 8
  170:        (begin
  171:          (hash-table-put! h-equal 'a 8)
  172:          (hash-table-get  h-equal 'a)))
  173: 
  174: (test* "b => non" #t
  175:        (hash-table-get  h-equal 'b #t))
  176: 
  177: (test* "b => error" *test-error*
  178:        (hash-table-get  h-equal 'b))
  179: 
  180: (test* "b => \"b\"" "b"
  181:        (begin
  182:          (hash-table-put! h-equal 'b "b")
  183:          (hash-table-get  h-equal 'b)))
  184: 
  185: (test* "2.0 => #\C" #\C
  186:        (begin
  187:          (hash-table-put! h-equal 2.0 #\C)
  188:          (hash-table-get  h-equal 2.0)))
  189: 
  190: (test* "2.0 => #\c" #\c
  191:        (begin
  192:          (hash-table-put! h-equal 2.0 #\c)
  193:          (hash-table-get  h-equal 2.0)))
  194: 
  195: (test* "87592876592374659237845692374523694756 => 0" 0
  196:        (begin
  197:          (hash-table-put! h-equal 87592876592374659237845692374523694756 0)
  198:          (hash-table-get  h-equal 87592876592374659237845692374523694756)))
  199: 
  200: (test* "87592876592374659237845692374523694756 => -1" -1
  201:        (begin
  202:          (hash-table-put! h-equal 87592876592374659237845692374523694756 -1)
  203:          (hash-table-get  h-equal 87592876592374659237845692374523694756)))
  204: 
  205: (test* "e => \"e\"" "E"
  206:        (begin
  207:          (hash-table-put! h-equal 'e "e")
  208:          (hash-table-update! h-equal 'e (lambda (x) (string-upcase x)))
  209:          (hash-table-get h-equal 'e)))
  210: 
  211: (test* "equal? test" 6
  212:        (begin
  213:          (hash-table-put! h-equal (string #\d) 4)
  214:          (hash-table-put! h-equal (string #\d) 5)
  215:          (length (hash-table-keys h-equal))))
  216: 
  217: (test* "equal? test" 7
  218:        (begin
  219:          (hash-table-put! h-equal (cons 'a 'b) 6)
  220:          (hash-table-put! h-equal (cons 'a 'b) 7)
  221:          (length (hash-table-keys h-equal))))
  222: 
  223: (test* "equal? test" 8
  224:        (begin
  225:          (hash-table-put! h-equal (vector (cons 'a 'b) 3+3i) 60)
  226:          (hash-table-put! h-equal (vector (cons 'a 'b) 3+3i) 61)
  227:          (length (hash-table-keys h-equal))))
  228: 
  229: (test* "hash-table-values(3)" #t
  230:        (lset= equal? (hash-table-values h-equal) '(8 "b" #\c -1 "E" 5 7 61)))
  231: 
  232: (test* "delete!" #f
  233:        (begin
  234:          (hash-table-delete! h-equal (vector (cons 'a 'b) 3+3i))
  235:          (hash-table-get h-equal (vector (cons 'a 'b) 3+3i) #f)))
  236: 
  237: ;;------------------------------------------------------------------
  238: (test-section "string?-hash")
  239: 
  240: (define h-string (make-hash-table 'string=?))
  241: 
  242: (test* "make-hash-table" #t
  243:        (hash-table? h-string))
  244: 
  245: (test* "hash-table-type" 'string=?
  246:        (hash-table-type h-string))
  247: 
  248: (test* "\"a\" => 8" 8
  249:        (begin
  250:          (hash-table-put! h-string "a" 8)
  251:          (hash-table-get  h-string "a")))
  252: 
  253: (test* "\"b\" => non" #t
  254:        (hash-table-get  h-string "b" #t))
  255: 
  256: (test* "\"b\" => non" *test-error*
  257:        (hash-table-get  h-string "b"))
  258: 
  259: (test* "\"b\" => \"b\"" "b"
  260:        (begin
  261:          (hash-table-put! h-string "b" "b")
  262:          (hash-table-get  h-string "b")))
  263: 
  264: (test* "string=? test" 3
  265:        (begin
  266:          (hash-table-put! h-string (string #\d) 4)
  267:          (hash-table-put! h-string (string #\d) 5)
  268:          (length (hash-table-keys h-string))))
  269: 
  270: (test* "\"e\" => 9" 9
  271:        (begin
  272:          (hash-table-put! h-string "e" 8)
  273:          (hash-table-update! h-string "e" (lambda (x) (+ x 1)))
  274:          (hash-table-get h-string "e")))
  275: 
  276: (test* "hash-table-values(4)" #t
  277:        (lset= equal? (hash-table-values h-string) '(8 "b" 5 9)))
  278: 
  279: (test* "delete!" #f
  280:        (begin
  281:          (hash-table-delete! h-string "d")
  282:          (hash-table-get h-string "d" #f)))
  283: 
  284: ;;------------------------------------------------------------------
  285: (test-section "iterators")
  286: 
  287: (define h-it (hash-table 'eq?
  288:                          '(a . 3)
  289:                          '(c . 8)
  290:                          '(b . 4)
  291:                          '(d . 10)))
  292: 
  293: (test* "hash-table"
  294:        '(a b c d)
  295:        (hash-table-keys h-it)
  296:        (lambda (a b) (lset= equal? a b)))
  297: 
  298: (test* "hash-table-map"
  299:        '((a . 3) (b . 4) (c . 8) (d . 10))
  300:        (hash-table-map h-it cons)
  301:        (lambda (a b) (lset= equal? a b)))
  302: 
  303: (test* "hash-table-for-each"
  304:        '((a . 3) (b . 4) (c . 8) (d . 10))
  305:        (let ((r '()))
  306:          (hash-table-for-each h-it (lambda (k v) (push! r (cons k v))))
  307:          r)
  308:        (lambda (a b) (lset= equal? a b)))
  309: 
  310: (test* "hash-table-fold"
  311:        '((a . 3) (b . 4) (c . 8) (d . 10))
  312:        (hash-table-fold h-it acons '())
  313:        (lambda (a b) (lset= equal? a b)))
  314: 
  315: (test-module 'gauche.hashutil) ; autoloaded module
  316: 
  317: (test-end)