Ticket #1293: srfi-69-testcases.patch

File srfi-69-testcases.patch, 2.1 KB (added by sjamaan, 5 years ago)

A patch for the srfi-69 test suite to detect these problems

  • tests/hash-table-tests.scm

    diff --git a/tests/hash-table-tests.scm b/tests/hash-table-tests.scm
    index 99960bd..61c849e 100644
    a b  
    11;;;; hash-table-tests.scm
    22
    3 (require-extension srfi-69 data-structures extras)
     3(require-extension srfi-69 data-structures extras lolevel)
    44
    55(print "SRFI 69 procedures")
    66(assert (eq? hash equal?-hash))
     
    240240      (recursive-hash-max-length dl)
    241241      (print hsh1 " <?> " hsh2)
    242242      (assert (not (= hsh1 hsh2))) ) ) )
     243
     244;; Regression test for #1293, found by John Croisant
     245(print "HT - Retrieve compound objects after GC and mutate contents")
     246(set! ht (make-hash-table eq? hash-by-identity))
     247(let* ((lst (list 1 2 3))
     248       (vec (vector 1 2 3))
     249       (pvec (make-pointer-vector 5 (address->pointer 1)))
     250       (loc (make-locative (cons 1 2)))
     251       (str (string #\x #\y #\z))
     252       (objects (list lst vec pvec loc str))
     253       (hashes (map hash-by-identity objects)))
     254
     255  (for-each (lambda (obj) (hash-table-set! ht obj obj))
     256            objects)
     257
     258;  (gc #t)
     259
     260  (for-each (lambda (obj)
     261              (print "Exists? " obj)
     262              (assert (hash-table-exists? ht obj)))
     263            objects)
     264
     265  (for-each (lambda (obj hash)
     266              (print "Same hash? " obj)
     267              (assert (= (hash-by-identity obj) hash)))
     268            objects hashes)
     269
     270  (print "After mutation")
     271
     272  (set-car! lst (string #\l #\s #\t))
     273  (vector-set! vec 0 (string #\v #\e #\c))
     274  (pointer-vector-set! pvec 0 (address->pointer 0))
     275  (locative-set! loc (string #\h #\a #\i))
     276  (string-set! str 0 #\f)
     277
     278  ;; In each case, the object is the same: only contents have changed
     279  (for-each (lambda (obj)
     280              (print "Exists? " obj)
     281              (assert (hash-table-exists? ht obj)))
     282            objects)
     283
     284  (for-each (lambda (obj hash)
     285              (print "Same hash? " obj)
     286              (assert (= (hash-by-identity obj) hash)))
     287            objects hashes)
     288
     289  (gc #t)
     290
     291  (for-each (lambda (obj)
     292              (print "Exists? " obj)
     293              (assert (hash-table-exists? ht obj)))
     294            objects)
     295
     296  (for-each (lambda (obj hash)
     297              (print "Same hash? " obj)
     298              (assert (= (hash-by-identity obj) hash)))
     299            objects hashes))