From 25a1792fd001ae449b60cfba93751f51b970b466 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Tue, 19 Dec 2017 17:53:07 +0300 Subject: [PATCH] tests: put impure testing code into a file. Instead of passing it via --eval. --- tests/impure-runner.lisp | 42 ++++++++++++++++ tests/run-tests.lisp | 128 ++++++++++++----------------------------------- tests/test-funs.lisp | 32 ++++++++++++ 3 files changed, 106 insertions(+), 96 deletions(-) create mode 100644 tests/impure-runner.lisp create mode 100644 tests/test-funs.lisp diff --git a/tests/impure-runner.lisp b/tests/impure-runner.lisp new file mode 100644 index 000000000..04a2879a3 --- /dev/null +++ b/tests/impure-runner.lisp @@ -0,0 +1,42 @@ +(load "test-util") +(load "assertoid") + +(defpackage :run-tests + (:use :cl :test-util :sb-ext)) + +(in-package :cl-user) +(use-package :test-util) +(use-package :assertoid) + +(defvar *break-on-error*) + +(load "test-funs") + +(defun run (file test-fun + break-on-failure break-on-expected-failure break-on-error + interpret) + (setf *break-on-failure* break-on-failure + *break-on-expected-failure* break-on-expected-failure + *break-on-error* break-on-error) + (when interpret + (setf *evaluator-mode* :interpret) + (push :interpreter *features*)) + (format t "// Running ~a in ~a evaluator mode~%" + file *evaluator-mode*) + (restart-case + (handler-bind + ((error (lambda (condition) + (push (list :unhandled-error file) + *failures*) + (cond (*break-on-error* + (test-util:really-invoke-debugger condition)) + (t + (format *error-output* "~&Unhandled ~a: ~a~%" + (type-of condition) condition) + (sb-debug:print-backtrace))) + (invoke-restart 'skip-file)))) + (funcall test-fun file)) + (skip-file () + (format t ">>>~a<<<~%"*failures*))) + (report-test-status) + (exit :code 104)) diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index adac66796..905669cfc 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -9,12 +9,13 @@ (load "colorize.lisp") -(defvar *test-evaluator-mode* :compile) (defvar *all-failures* nil) (defvar *break-on-error* nil) (defvar *report-skipped-tests* nil) (defvar *explicit-test-files* nil) +(load "test-funs") + (defun run-all () (loop :with remainder = (rest *posix-argv*) :while remainder @@ -42,11 +43,11 @@ (t (push (truename (parse-namestring arg)) *explicit-test-files*)))) (setf *explicit-test-files* (nreverse *explicit-test-files*)) - (pure-runner (pure-load-files) #'load-test) - (pure-runner (pure-cload-files) #'cload-test) - (impure-runner (impure-load-files) #'load-test) - (impure-runner (impure-cload-files) #'cload-test) - #-win32 (impure-runner (sh-files) #'sh-test) + (pure-runner (pure-load-files) 'load-test) + (pure-runner (pure-cload-files) 'cload-test) + (impure-runner (impure-load-files) 'load-test) + (impure-runner (impure-cload-files) 'cload-test) + #-win32 (impure-runner (sh-files) 'sh-test) (report) (sb-ext:exit :code (if (unexpected-failures) 1 @@ -112,90 +113,51 @@ (if (eq sb-ext:*evaluator-mode* :interpret) (cons :interpreter *features*) *features*))) - (eval (funcall test-fun file)))) + (funcall test-fun file))) (skip-file ()))) (append-failures)))) -(defun run-in-child-sbcl (load-forms forms) +(defun run-in-child-sbcl (eval) (process-exit-code (sb-ext:run-program (first *POSIX-ARGV*) - (list* "--core" SB-INT:*CORE-STRING* + (list "--core" SB-INT:*CORE-STRING* "--noinform" "--no-sysinit" "--no-userinit" "--noprint" "--disable-debugger" - (loop for form in (append load-forms forms) - collect "--eval" - collect (write-to-string form))) + "--eval" (let ((*package* #.*package*)) + (write-to-string eval + :right-margin 1000))) :output t :input t))) -(defun clear-test-status () - (with-open-file (stream "test-status.lisp-expr" - :direction :output - :if-exists :supersede) - (write-line "NIL" stream))) - -(defun run-impure-in-child-sbcl (test-file test-code) +(defun run-impure-in-child-sbcl (test-file test-fun) (clear-test-status) (run-in-child-sbcl - `((load "test-util") - (load "assertoid") - (defpackage :run-tests - (:use :cl :test-util :sb-ext))) - - `((in-package :cl-user) - (use-package :test-util) - (use-package :assertoid) - (setf test-util:*break-on-failure* ,test-util:*break-on-failure*) - (setf test-util:*break-on-expected-failure* - ,test-util:*break-on-expected-failure*) - (let* ((file ,test-file) - (sb-ext:*evaluator-mode* ,*test-evaluator-mode*) - (*features* - (if (eq sb-ext:*evaluator-mode* :interpret) - (cons :interpreter *features*) - *features*)) - (*break-on-error* ,run-tests::*break-on-error*)) - (declare (special *break-on-error*)) - (format t "// Running ~a in ~a evaluator mode~%" - file sb-ext:*evaluator-mode*) - (restart-case - (handler-bind - ((error (lambda (condition) - (push (list :unhandled-error file) - test-util::*failures*) - (cond (*break-on-error* - (test-util:really-invoke-debugger condition)) - (t - (format *error-output* "~&Unhandled ~a: ~a~%" - (type-of condition) condition) - (sb-debug:print-backtrace))) - (invoke-restart 'skip-file)))) - ,test-code) - (skip-file () - (format t ">>>~a<<<~%" test-util::*failures*))) - (test-util:report-test-status) - (sb-ext:exit :code 104))))) + `(progn + (load "impure-runner") + (run ,(enough-namestring test-file) + ',test-fun + ,*break-on-failure* + ,*break-on-expected-failure* + ,*break-on-error* + ,(eq sb-ext:*evaluator-mode* :interpret))))) (defun impure-runner (files test-fun) (when files (format t "// Running impure tests (~a)~%" test-fun) - (let ((*package* (find-package :cl-user))) - (setup-cl-user) - (dolist (file files) - (force-output) - (let ((exit-code (run-impure-in-child-sbcl file - (funcall test-fun file)))) - (if (= exit-code 104) - (with-open-file (stream "test-status.lisp-expr" - :direction :input - :if-does-not-exist :error) - (append-failures (read stream))) - (push (list :invalid-exit-status file) - *all-failures*))))))) + (dolist (file files) + (force-output) + (let ((exit-code (run-impure-in-child-sbcl file test-fun))) + (if (= exit-code 104) + (with-open-file (stream "test-status.lisp-expr" + :direction :input + :if-does-not-exist :error) + (append-failures (read stream))) + (push (list :invalid-exit-status file) + *all-failures*)))))) (defun make-error-handler (file) (lambda (condition) @@ -223,32 +185,6 @@ (use-package :test-util) (use-package :assertoid)) -(defun load-test (file) - `(load ,file :external-format :utf-8)) - -(defun cload-test (file) - `(let ((compile-name (compile-file-pathname ,file))) - (unwind-protect - (progn - (compile-file ,file :print nil) - (load compile-name)) - (ignore-errors - (delete-file compile-name))))) - -(defun sh-test (file) - ;; What? No SB-POSIX:EXECV? - (clear-test-status) - `(progn - (sb-posix:setenv "TEST_SBCL_EVALUATOR_MODE" - (string-downcase ,*test-evaluator-mode*) - 1) - (let ((process (sb-ext:run-program "/bin/sh" - (list (native-namestring ,file)) - :output *error-output*))) - (let ((*failures* nil)) - (test-util:report-test-status)) - (sb-ext:exit :code (process-exit-code process))))) - (defun filter-test-files (wild-mask) (if *explicit-test-files* (loop for file in *explicit-test-files* diff --git a/tests/test-funs.lisp b/tests/test-funs.lisp new file mode 100644 index 000000000..04e0eed03 --- /dev/null +++ b/tests/test-funs.lisp @@ -0,0 +1,32 @@ +(defvar *test-evaluator-mode* :compile) + +(defun clear-test-status () + (with-open-file (stream "test-status.lisp-expr" + :direction :output + :if-exists :supersede) + (write-line "NIL" stream))) + +(defun load-test (file) + (load file :external-format :utf-8)) + +(defun cload-test (file) + (let ((compile-name (compile-file-pathname file))) + (unwind-protect + (progn + (compile-file file :print nil) + (load compile-name)) + (ignore-errors + (delete-file compile-name))))) + +(defun sh-test (file) + (clear-test-status) + (progn + (sb-posix:setenv "TEST_SBCL_EVALUATOR_MODE" + (string-downcase *test-evaluator-mode*) + 1) + (let ((process (sb-ext:run-program "/bin/sh" + (list (native-namestring file)) + :output *error-output*))) + (let ((*failures* nil)) + (test-util:report-test-status)) + (sb-ext:exit :code (process-exit-code process))))) -- 2.11.4.GIT