Commit 5a17c072 authored by Salvador Fandino's avatar Salvador Fandino Committed by Attila Lendvai
Browse files

fix hygiene and multiple evaluation in ENSURE-GETHASH

Fixed problems:

1) Unintended variable capture affecting KEY, HASH-TABLE and DEFAULT
2) Multiple evaluation of the KEY and HASH-TABLE forms
parent b1c6ee03
......@@ -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"))
......@@ -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))))))
......@@ -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)))))))
(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)
:bar nil :bar t 3)
(deftest copy-hash-table.1
(let ((orig (make-hash-table :test 'eq :size 123))
(foo "foo"))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment