Skip to content
Snippets Groups Projects
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
   FORMS
2) Multiple evaluation of the KEY and HASH-TABLE forms
parent b1c6ee03
No related branches found
No related tags found
No related merge requests found
...@@ -46,9 +46,9 @@ the following constraints: ...@@ -46,9 +46,9 @@ the following constraints:
(:file "binding" :depends-on ("package")) (:file "binding" :depends-on ("package"))
(:file "strings" :depends-on ("package")) (:file "strings" :depends-on ("package"))
(:file "conditions" :depends-on ("package")) (:file "conditions" :depends-on ("package"))
(:file "hash-tables" :depends-on ("package"))
(:file "io" :depends-on ("package" "macros" "lists" "types")) (:file "io" :depends-on ("package" "macros" "lists" "types"))
(:file "macros" :depends-on ("package" "strings" "symbols")) (:file "macros" :depends-on ("package" "strings" "symbols"))
(:file "hash-tables" :depends-on ("package" "macros"))
(:file "control-flow" :depends-on ("package" "definitions" "macros")) (:file "control-flow" :depends-on ("package" "definitions" "macros"))
(:file "symbols" :depends-on ("package")) (:file "symbols" :depends-on ("package"))
(:file "functions" :depends-on ("package" "symbols" "macros")) (:file "functions" :depends-on ("package" "symbols" "macros"))
......
...@@ -93,7 +93,9 @@ PLIST. Hash table is initialized using the HASH-TABLE-INITARGS." ...@@ -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 "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 under key before returning it. Secondary return value is true if key was
already in the table." already in the table."
`(multiple-value-bind (value ok) (gethash ,key ,hash-table) (once-only (key hash-table)
(if ok (with-unique-names (value presentp)
(values value ok) `(multiple-value-bind (,value ,presentp) (gethash ,key ,hash-table)
(values (setf (gethash ,key ,hash-table) ,default) nil)))) (if ,presentp
(values ,value ,presentp)
(values (setf (gethash ,key ,hash-table) ,default) nil))))))
...@@ -239,7 +239,7 @@ ...@@ -239,7 +239,7 @@
;;;; Hash tables ;;;; Hash tables
(deftest ensure-hash-table.1 (deftest ensure-gethash.1
(let ((table (make-hash-table)) (let ((table (make-hash-table))
(x (list 1))) (x (list 1)))
(multiple-value-bind (value already-there) (multiple-value-bind (value already-there)
...@@ -254,6 +254,17 @@ ...@@ -254,6 +254,17 @@
(= 42 (gethash x table))))))) (= 42 (gethash x table)))))))
t) 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 (deftest copy-hash-table.1
(let ((orig (make-hash-table :test 'eq :size 123)) (let ((orig (make-hash-table :test 'eq :size 123))
(foo "foo")) (foo "foo"))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment