Fix HASH-TABLE-UPDATE!/DEFAULT to conform to silly specification.

Add regression tests.

I missed this when I fixed HASH-TABLE-UPDATE! a while ago.

diff --git a/src/runtime/hashtb.scm b/src/runtime/hashtb.scm
index db80ea3495c6b6119e52f8f89ffe9a3e1a5ffd1d..5675eed6968ef050f592acc8ec10e7af24a31c4c 100644 (file)
--- a/src/runtime/hashtb.scm
+++ b/src/runtime/hashtb.scm
@@ -1313,6 +1313,9 @@ USA.
                          (error:bad-range-argument key 'HASH-TABLE-UPDATE!))
                        get-default)))))
 
+(define (hash-table-update!/default table key procedure default)
+  (hash-table-update! table key procedure (lambda () default)))
+
 (define (hash-table-copy table)
   (guarantee-hash-table table 'HASH-TABLE-COPY)
   (with-table-locked! table

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 740da650fc7274b6a3831b7e0e1d8f8c82204de4..98bfc7afc22eed0003cce426873f76410e3b7d26 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2071,7 +2071,6 @@ USA.
          (hash-table-ref/default hash-table/get)
          (hash-table-set! hash-table/put!)
          (hash-table-size hash-table/count)
-         (hash-table-update!/default hash-table/modify!)
          (hash-table-values hash-table/datum-list)
          (hash-table-walk hash-table/for-each)
          (make-eq-hash-table make-key-weak-eq-hash-table)
@@ -2108,6 +2107,7 @@ USA.
          hash-table-ref
          hash-table-type?
          hash-table-update!
+         hash-table-update!/default
          hash-table/clean!
          hash-table/clear!
          hash-table/constructor

diff --git a/tests/runtime/test-hash-table.scm b/tests/runtime/test-hash-table.scm
index b03a5567f03ae45fab546bfaa5d069797588ad9b..578bd40786d897bfa0feb2518a70e95c3bcd9775 100644 (file)
--- a/tests/runtime/test-hash-table.scm
+++ b/tests/runtime/test-hash-table.scm
@@ -251,6 +251,34 @@ USA.
          'WIN))
       (assert-eqv (hash-table/get hash-table 0 'LOSE-2) 'WIN))))
 
+(define-test 'REGRESSION:MODIFICATION-DURING-SRFI-69-UPDATE/DEFAULT:0
+  (lambda ()
+    (let ((hash-table
+          ((strong-hash-table/constructor (lambda (k m) k m 0) eqv?))))
+      (hash-table/put! hash-table 0 'LOSE-0)
+      (hash-table-update!/default hash-table 0
+        (lambda (datum)
+          datum                                ;ignore
+          ;; Force consing a new entry.
+          (hash-table/remove! hash-table 0)
+          (hash-table/put! hash-table 0 'LOSE-1)
+          'WIN)
+        'LOSE-2)
+      (assert-eqv (hash-table/get hash-table 0 'LOSE-3) 'WIN))))
+
+(define-test 'REGRESSION:MODIFICATION-DURING-SRFI-69-UPDATE/DEFAULT:1
+  (lambda ()
+    (let ((hash-table
+          ((strong-hash-table/constructor (lambda (k m) k m 0) eqv?))))
+      (hash-table-update!/default hash-table 0
+       (lambda (datum)
+         datum                         ;ignore
+         (hash-table/put! hash-table 1 'WIN-1)
+         'WIN-0)
+        'LOSE-0A)
+      (assert-eqv (hash-table/get hash-table 0 'LOSE-0B) 'WIN-0)
+      (assert-eqv (hash-table/get hash-table 1 'LOSE-1) 'WIN-1))))
+
 (define-test 'REGRESSION:MODIFICATION-DURING-SRFI-69-FOLD
   (lambda ()
     (let* ((index 1)