From 5a17c072970cf50213f7f896c40e6e640638391f Mon Sep 17 00:00:00 2001
From: Salvador Fandino <sfandino@gmail.com>
Date: Sat, 25 Apr 2015 22:13:24 +0200
Subject: [PATCH] fix hygiene and multiple evaluation in ENSURE-GETHASH

Fixed problems:

1) Unintended variable capture affecting KEY, HASH-TABLE and DEFAULT
   FORMS
2) Multiple evaluation of the KEY and HASH-TABLE forms
---
 alexandria.asd   |  2 +-
 hash-tables.lisp | 10 ++++++----
 tests.lisp       | 13 ++++++++++++-
 3 files changed, 19 insertions(+), 6 deletions(-)

diff --git a/alexandria.asd b/alexandria.asd
index 5277631..f8bf281 100644
--- a/alexandria.asd
+++ b/alexandria.asd
@@ -46,9 +46,9 @@ the following constraints:
    (:file "binding" :depends-on ("package"))
    (:file "strings" :depends-on ("package"))
    (:file "conditions" :depends-on ("package"))
-   (:file "hash-tables" :depends-on ("package"))
    (:file "io" :depends-on ("package" "macros" "lists" "types"))
    (:file "macros" :depends-on ("package" "strings" "symbols"))
+   (:file "hash-tables" :depends-on ("package" "macros"))
    (:file "control-flow" :depends-on ("package" "definitions" "macros"))
    (:file "symbols" :depends-on ("package"))
    (:file "functions" :depends-on ("package" "symbols" "macros"))
diff --git a/hash-tables.lisp b/hash-tables.lisp
index 65253e7..3a6c3eb 100644
--- a/hash-tables.lisp
+++ b/hash-tables.lisp
@@ -93,7 +93,9 @@ PLIST. Hash table is initialized using the HASH-TABLE-INITARGS."
   "Like GETHASH, but if KEY is not found in the HASH-TABLE saves the DEFAULT
 under key before returning it. Secondary return value is true if key was
 already in the table."
-  `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
-     (if ok
-         (values value ok)
-         (values (setf (gethash ,key ,hash-table) ,default) nil))))
+  (once-only (key hash-table)
+    (with-unique-names (value presentp)
+      `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
+         (if ,presentp
+             (values ,value ,presentp)
+             (values (setf (gethash ,key ,hash-table) ,default) nil))))))
diff --git a/tests.lisp b/tests.lisp
index 605fc66..a3fe840 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -239,7 +239,7 @@
 
 ;;;; Hash tables
 
-(deftest ensure-hash-table.1
+(deftest ensure-gethash.1
     (let ((table (make-hash-table))
           (x (list 1)))
       (multiple-value-bind (value already-there)
@@ -254,6 +254,17 @@
                     (= 42 (gethash x table)))))))
   t)
 
+(deftest ensure-gethash.2
+    (let ((table (make-hash-table))
+          (count 0))
+      (multiple-value-call #'values
+        (ensure-gethash (progn (incf count) :foo)
+                        (progn (incf count) table)
+                        (progn (incf count) :bar))
+        (gethash :foo table)
+        count))
+  :bar nil :bar t 3)
+
 (deftest copy-hash-table.1
     (let ((orig (make-hash-table :test 'eq :size 123))
           (foo "foo"))
-- 
GitLab