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