| 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)) |