Delete a support for toplevel assertions for reducing memory since it…

…'s not used, I think.
fukamachi · Aug 7, 2019 · 8859b0a · 8859b0a
1 parent 68fd438
commit 8859b0a
Show file tree

Hide file tree

Showing 4 changed files with 55 additions and 79 deletions.
diff --git a/core/assertion.lisp b/core/assertion.lisp
@@ -4,8 +4,6 @@
         #:rove/core/stats
         #:rove/core/result)
   (:shadow #:continue)
-  (:import-from #:rove/core/suite/package
-                #:wrap-if-toplevel)
   (:import-from #:dissect
                 #:stack)
   (:export #:*debug-on-error*
@@ -125,25 +123,27 @@
                                       (invoke-restart restart))))))
                  (main))))))))
 
+(defun ok-assertion-class (result error)
+  (declare (ignore error))
+  (if result
+    'passed-assertion
+    'failed-assertion))
+
 (defmacro ok (form &optional desc)
-  `(wrap-if-toplevel
-    (%okng ,form ,desc
-           (lambda (result error)
-             (declare (ignore error))
-             (if result
-                 'passed-assertion
-                 'failed-assertion))
-           t)))
+  `(%okng ,form ,desc
+          #'ok-assertion-class
+          t))
+
+(defun ng-assertion-class (result error)
+  (cond
+    (error 'failed-assertion)
+    (result 'failed-assertion)
+    (t 'passed-assertion)))
 
 (defmacro ng (form &optional desc)
-  `(wrap-if-toplevel
-    (%okng ,form ,desc
-           (lambda (result error)
-             (cond
-               (error 'failed-assertion)
-               (result 'failed-assertion)
-               (t 'passed-assertion)))
-           nil)))
+  `(%okng ,form ,desc
+          #'ng-assertion-class
+          nil))
 
 (defmacro signals (form &optional (condition ''error))
   "Returns t if given form raise condition of given type,
@@ -215,25 +215,22 @@
           (second args)))
 
 (defun pass (desc)
-  (wrap-if-toplevel
-   (record *stats*
-           (make-instance 'passed-assertion
-                          :form t
-                          :desc desc))
-   t))
+  (record *stats*
+          (make-instance 'passed-assertion
+                         :form t
+                         :desc desc))
+  t)
 
 (defun fail (desc)
-  (wrap-if-toplevel
-   (record *stats*
-           (make-instance 'failed-assertion
-                          :form t
-                          :desc desc))
-   nil))
+  (record *stats*
+          (make-instance 'failed-assertion
+                         :form t
+                         :desc desc))
+  nil)
 
 (defun skip (desc)
-  (wrap-if-toplevel
-   (record *stats*
-           (make-instance 'pending-assertion
-                          :form t
-                          :desc desc))
-   t))
+  (record *stats*
+          (make-instance 'pending-assertion
+                         :form t
+                         :desc desc))
+  t)
diff --git a/core/suite.lisp b/core/suite.lisp
@@ -9,7 +9,6 @@
                 #:test-name)
   (:import-from #:rove/core/suite/package
                 #:get-test
-                #:*execute-assertions*
                 #:system-suites
                 #:suite-name
                 #:run-suite)
@@ -32,7 +31,6 @@
   (let ((system (asdf:find-system system-designator)))
     (let ((*stats* (or *stats*
                        (make-instance 'stats)))
-          (*execute-assertions* nil)
           (*standard-output* (or *rove-standard-output*
                                  *standard-output*))
           (*error-output* (or *rove-error-output*
@@ -41,29 +39,28 @@
       #+quicklisp (ql:quickload (asdf:component-name system) :silent t)
       #-quicklisp (asdf:load-system (asdf:component-name system))
 
-      (let ((*execute-assertions* t))
-        (testing (format nil "Testing System ~A" (asdf:component-name system))
-          (typecase system
-            (asdf:package-inferred-system
-             (let* ((package-name (string-upcase (asdf:component-name system)))
-                    (package (find-package package-name)))
-               (unless package
-                 (setf package (find-package package-name)))
-               ;; Loading dependencies beforehand
-               (let ((pkgs (system-packages system)))
-                 (dolist (package pkgs)
-                   (when (package-tests package)
-                     (format t "~2&;; testing '~(~A~)'~%" (package-name package))
-                     (run-package-tests package))))
+      (testing (format nil "Testing System ~A" (asdf:component-name system))
+        (typecase system
+          (asdf:package-inferred-system
+            (let* ((package-name (string-upcase (asdf:component-name system)))
+                   (package (find-package package-name)))
+              (unless package
+                (setf package (find-package package-name)))
+              ;; Loading dependencies beforehand
+              (let ((pkgs (system-packages system)))
+                (dolist (package pkgs)
+                  (when (package-tests package)
+                    (format t "~2&;; testing '~(~A~)'~%" (package-name package))
+                    (run-package-tests package))))
 
-               (when (and package
-                          (package-tests package))
-                 (format t "~2&;; testing '~(~A~)'~%" (package-name package))
-                 (run-package-tests package))))
-            (otherwise
-             (dolist (suite (system-suites system))
-               (format t "~2&;; testing '~(~A~)'~%" (suite-name suite))
-               (run-suite suite))))))
+              (when (and package
+                         (package-tests package))
+                (format t "~2&;; testing '~(~A~)'~%" (package-name package))
+                (run-package-tests package))))
+          (otherwise
+            (dolist (suite (system-suites system))
+              (format t "~2&;; testing '~(~A~)'~%" (suite-name suite))
+              (run-suite suite)))))
 
       (let ((test (if (/= (length (stats-failed *stats*)) 0)
                       (aref (stats-failed *stats*) 0)

diff --git a/core/suite/package.lisp b/core/suite/package.lisp
@@ -7,8 +7,6 @@
                 #:system-packages)
   (:export #:all-suites
            #:system-suites
-           #:*execute-assertions*
-           #:wrap-if-toplevel
            #:get-test
            #:set-test
            #:suite-name
@@ -41,8 +39,6 @@
   after-hooks
   tests)
 
-(defvar *execute-assertions* t)
-
 (defun make-new-suite (package)
   (let ((pathname (resolve-file (or *load-pathname* *compile-file-pathname*))))
     (when (and pathname
@@ -68,19 +64,6 @@
   (setf (get name 'test) test-fn)
   name)
 
-(defmacro wrap-if-toplevel (&body body)
-  (let ((main (gensym "MAIN")))
-    `(flet ((,main () ,@body))
-       (if *execute-assertions*
-           (,main)
-           (progn
-             (pushnew (lambda ()
-                        (let ((*execute-assertions* t))
-                          (,main)))
-                      (suite-tests (package-suite *package*))
-                      :test 'eq)
-             (values))))))
-
 (defun run-suite (suite)
   (let ((suite (typecase suite
                  (suite suite)

diff --git a/core/test.lisp b/core/test.lisp
@@ -27,7 +27,7 @@
 
 (defmacro testing (desc &body body)
   (let ((main (gensym "MAIN")))
-    `(wrap-if-toplevel
+    `(progn
        (test-begin *stats* ,desc)
        (unwind-protect
             (flet ((,main () ,@body))
@@ -76,7 +76,6 @@
   (check-type package package)
   (let ((test-name (string-downcase (package-name package)))
         (suite (package-suite package))
-        (*execute-assertions* t)
         (*package* package))
     (test-begin *stats* test-name (length (suite-tests suite)))
     (unwind-protect (run-suite suite)