From df20cd3bde0a7623b900e467bc7d02fafc8dfe56 Mon Sep 17 00:00:00 2001
From: digikar99 <shubhamkarayare@gmail.com>
Date: Fri, 16 Apr 2021 20:07:34 +0530
Subject: [PATCH] Avoid using eval inside def-test

---
 src/test.lisp | 49 ++++++++++++++++++++++++-------------------------
 1 file changed, 24 insertions(+), 25 deletions(-)

diff --git a/src/test.lisp b/src/test.lisp
index 32103d5..e46b353 100644
--- a/src/test.lisp
+++ b/src/test.lisp
@@ -103,36 +103,35 @@ If PROFILE is T profiling information will be collected as well."
                                (destructuring-bind (name &rest args)
                                    (ensure-list fixture)
                                  `((with-fixture ,name ,args ,@body-forms)))
-                               body-forms)))
+                               body-forms))
+           (lambda-name (format-symbol t "%~A-~A" '#:test name))
+           (inner-lambda-name (format-symbol t "%~A-~A" '#:inner-test name)))
       `(progn
-         (register-test ',name ,description ',effective-body ,suite-form ',depends-on ,compile-at ,profile)
+         (register-test ',name ,description
+                        (named-lambda ,lambda-name ()
+                          ,@(ecase compile-at
+                              (:run-time `((funcall
+                                            (let ((*package* (find-package ',(package-name *package*))))
+                                              (compile ',inner-lambda-name
+                                                       '(lambda () ,@effective-body))))))
+                              (:definition-time effective-body)))
+                        ,suite-form ',depends-on ,compile-at ,profile)
          (when *run-test-when-defined*
            (run! ',name))
          ',name))))
 
-(defun register-test (name description body suite depends-on compile-at profile)
-  (let ((lambda-name
-          (format-symbol t "%~A-~A" '#:test name))
-        (inner-lambda-name
-          (format-symbol t "%~A-~A" '#:inner-test name)))
-    (setf (get-test name)
-          (make-instance 'test-case
-                         :name name
-                         :runtime-package (find-package (package-name *package*))
-                         :test-lambda
-                         (eval
-                          `(named-lambda ,lambda-name ()
-                             ,@(ecase compile-at
-                                 (:run-time `((funcall
-                                               (let ((*package* (find-package ',(package-name *package*))))
-                                                 (compile ',inner-lambda-name
-                                                          '(lambda () ,@body))))))
-                                 (:definition-time body))))
-                         :description description
-                         :depends-on depends-on
-                         :collect-profiling-info profile
-                         :test-suite suite))
-    (setf (gethash name (tests suite)) name)))
+(defun register-test (name description test-lambda suite depends-on compile-at profile)
+  (declare (ignore compile-at))
+  (setf (get-test name)
+        (make-instance 'test-case
+                       :name name
+                       :runtime-package (find-package (package-name *package*))
+                       :test-lambda test-lambda
+                       :description description
+                       :depends-on depends-on
+                       :collect-profiling-info profile
+                       :test-suite suite))
+  (setf (gethash name (tests suite)) name))
 
 (defvar *run-test-when-defined* nil
   "When non-NIL tests are run as soon as they are defined.")