diff --git a/src/code/parse-defmacro.lisp b/src/code/parse-defmacro.lisp
index 5a42651..1222928 100644
--- a/src/code/parse-defmacro.lisp
+++ b/src/code/parse-defmacro.lisp
@@ -378,22 +378,24 @@
 
 (defun push-optional-binding (value-var init-form suppliedp-name
                               &key is-supplied-p path name context error-fun)
-  (unless suppliedp-name
-    (setq suppliedp-name (gensym "SUPPLIEDP-")))
-  (push-let-binding suppliedp-name is-supplied-p :system t)
-  (cond ((consp value-var)
-         (let ((whole-thing (gensym "OPTIONAL-SUBLIST-")))
-           (push-sublist-binding whole-thing
-                                 `(if ,suppliedp-name ,path ,init-form)
-                                 value-var name context error-fun)
-           (parse-defmacro-lambda-list value-var whole-thing name
-                                       context
-                                       :error-fun error-fun
-                                       :sublist t)))
-        ((symbolp value-var)
-         (push-let-binding value-var path :when suppliedp-name :else init-form))
-        (t
-         (error "illegal optional variable name: ~S" value-var))))
+  (let ((sym (gensym "SUPPLIEDP-")))
+    (push-let-binding sym is-supplied-p :system t)
+    (cond ((consp value-var)
+           (let ((whole-thing (gensym "OPTIONAL-SUBLIST-")))
+             (push-sublist-binding whole-thing
+                                   `(if ,sym ,path ,init-form)
+                                   value-var name context error-fun)
+             (parse-defmacro-lambda-list value-var whole-thing name
+                                         context
+                                         :error-fun error-fun
+                                         :sublist t)))
+          ((symbolp value-var)
+           (push-let-binding value-var path :when sym :else init-form))
+          (t
+           (error "Illegal optional variable name: ~S" value-var)))
+    ;; Shouldn't be bound during the initform evaluation
+    (when suppliedp-name
+      (push-let-binding suppliedp-name sym))))
 
 (defun defmacro-error (problem context name)
   (error "illegal or ill-formed ~A argument in ~A~@[ ~S~]"
diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index 4328505..388b1a8 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -120,7 +120,7 @@ This is SETFable."
     (dolist (binding (reverse bindings))
       (/show binding)
       (destructuring-bind
-            (symbol type &optional (opt1 nil opt1p) (opt2 nil opt2p))
+          (symbol type &optional opt1 (opt2 nil opt2p))
           binding
         (/show symbol type opt1 opt2)
         (let* ((alien-type (parse-alien-type type env))
diff --git a/tests/lambda-list.pure.lisp b/tests/lambda-list.pure.lisp
index 3dd39db..7aeb91a 100644
--- a/tests/lambda-list.pure.lisp
+++ b/tests/lambda-list.pure.lisp
@@ -46,3 +46,21 @@
     (error-p (&optional foo &optional bar))
     (error-p (&rest foo &rest bar))
     (error-p (&rest foo &optional bar))))
+
+(with-test (:name :supplied-p-evaluation-order)
+  (let ((* 10))
+    (assert (eql ((lambda (&key (x * *)) () x)) 10))
+    (assert (eql ((lambda (&key (y * *) (x *)) () x) :y 1) t))
+    (assert (eql ((lambda (&key (x *) (y * *)) () x) :y 1) 10))
+
+    (assert (eql (destructuring-bind (&key (x * *)) () x) 10))
+    (assert (eql (destructuring-bind (&key (y * *) (x *)) '(:y 1) x) t))
+    (assert (eql (destructuring-bind (&key (x *) (y * *)) '(:y 1) x) 10))
+
+    (assert (eql ((lambda (&optional (x * *)) () x)) 10))
+    (assert (eql ((lambda (&optional (y * *) (x *)) () x) 1) t))
+    (assert (eql ((lambda (&optional (x *) (y * *)) () x)) 10))
+
+    (assert (eql (destructuring-bind (&optional (x * *)) () x) 10))
+    (assert (eql (destructuring-bind (&optional (y * *) (x *)) '(1) x) t))
+    (assert (eql (destructuring-bind (&optional (x *) (y * *)) () x) 10))))