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

alexandria.asd

+1 −1
Changes for alexandria.asd: 1 added line, 1 removed line.
Original line number Diff line number Diff line
@@ -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"))

hash-tables.lisp

+6 −4
Changes for hash-tables.lisp: 6 added lines, 4 removed lines.
Original line number Diff line number Diff line
@@ -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))))))

tests.lisp

+12 −1
Changes for tests.lisp: 12 added lines, 1 removed line.
Original line number Diff line number Diff line
@@ -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"))