From: Taylor R Campbell <campbell@mumble.net>
Date: Sun, 22 May 2011 20:49:50 +0000 (+0000)
Subject: Fix HASH-TABLE-UPDATE!/DEFAULT to conform to silly specification.
X-Git-Tag: 20110609-Gtk~1^2~11
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4d6552aeb76e248f952b9c42aa9b9434b681b27f;p=mit-scheme.git

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 db80ea349..5675eed69 100644
--- 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 740da650f..98bfc7afc 100644
--- 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 b03a5567f..578bd4078 100644
--- 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)