From 953ef4b5fc967245176d99065fd7d73d6ce7d22b Mon Sep 17 00:00:00 2001 From: "Paul M. Rodriguez" Date: Mon, 23 Dec 2024 12:20:36 -0600 Subject: [PATCH] Bug fix: href/@ compiler macros evaluate arguments left-to-right --- hash-tables.lisp | 11 +++++++++-- tests/hash-tables.lisp | 22 ++++++++++++++++++++++ 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/hash-tables.lisp b/hash-tables.lisp index f8d4009..b9feaa4 100644 --- a/hash-tables.lisp +++ b/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)) diff --git a/tests/hash-tables.lisp b/tests/hash-tables.lisp index 3c5d80f..3ade9c3 100644 --- a/tests/hash-tables.lisp +++ b/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)))))