Bug fix: href/@ compiler macros evaluate arguments left-to-right

Author: ruricolist

hash-tables.lisp

@@ -192,8 +192,15 @@ As soon as one of KEYS fails to match, DEFAULT is returned."
    keys
    :initial-value table))
 
-(define-compiler-macro href (table &rest keys)
-    (expand-href table keys))
+(define-compiler-macro href (table key &rest keys)
+  (let* ((keys (cons key keys))
+         (table-tmp (gensym (string 'table)))
+         (key-tmps
+           (make-gensym-list (length keys)
+                             (string 'key))))
+    `(let ((,table-tmp ,table)
+           ,@(mapcar #'list key-tmps keys))
+       ,(expand-href table-tmp key-tmps))))
 
 (define-compiler-macro (setf href) (value table &rest keys)
   `(setf ,(expand-href table keys) ,value))

tests/hash-tables.lisp

@@ -137,3 +137,25 @@
   (dolist (test '(eq eql equal equalp))
     (is (hash-table-test-p (symbol-function test))))
   (is (not (hash-table-test-p #'car))))
+
+(test href-eval-order
+  "Test that href arguments are evaluated left-to-right.
+Regression for href/@ compiler macros."
+  (let ((table (dict :x (dict :y (dict :z 'correct))))
+        (list '()))
+    (is (eql 'correct
+             (href
+              (progn (push 4 list) table)
+              (progn (push 3 list) :x)
+              (progn (push 2 list) :y)
+              (progn (push 1 list) :z))))
+    (is (equal list '(1 2 3 4))))
+  (let ((table (dict :x (dict :y (dict :z 'correct))))
+        (list '()))
+    (is (eql 'correct
+             (@
+              (progn (push 4 list) table)
+              (progn (push 3 list) :x)
+              (progn (push 2 list) :y)
+              (progn (push 1 list) :z))))
+    (is (equal list '(1 2 3 4)))))