run-tests.lisp 2.22 KB
Newer Older
1 2 3
#!/usr/local/bin/sbcl --script

;;; roughly in order of how long the tests take to run
4
(defvar implementations '("sbcl-bin" "clisp" "ccl-bin" "allegro"
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
                          "ecl" "abcl-bin"))

(let ((installed (with-output-to-string (out)
                   (sb-ext:run-program "ros" '("list" "installed")
                                       :search t :output out))))
  (dolist (implementation implementations)
    (unless (search implementation installed)
      (write-string "Installing ") (write-line implementation)
      (sb-ext:run-program "ros" (list "install" implementation)
                          :search t :output t)
      (terpri))))

(write-line "Starting tests")

(defvar test-code
  "(setq *debugger-hook*
         (lambda (condition x)
           (declare (ignore x))
           (let ((*standard-output* uiop:*stderr*))
             (fresh-line)
             (write-string \"Debugger entered with error \")
             (princ (type-of condition))
             (write-string \": \")
             (princ condition)
             (terpri)
             (uiop:quit 1))))
   (ql:quickload \"uri-template2/test\")
32 33 34 35
   (handler-case
       (asdf:test-system \"uri-template2\")
     (uri-template2/test:suite-failure (condition)
       (princ condition uiop:*stderr*)
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
       (uiop:quit 1)))")

;;; make sure ASDF is loading the system from the current directory
(require :sb-posix)
(sb-posix:setenv "CL_SOURCE_REGISTRY"
                 (directory-namestring *load-truename*)
                 1)

(dolist (implementation implementations)
  (write-string "Running tests in ") (write-string implementation)
  (finish-output)

  (let* ((stderr (make-string-output-stream))
         (exit-code
          (sb-ext:process-exit-code
           (sb-ext:run-program
            "ros"
            (list "run" "-L" implementation "-e" test-code "-q")
            :search t :error stderr))))
    (if (/= 0 exit-code)
        (progn (write-line ": FAILURE")
               (write-string "Error running tests in " *error-output*)
               (write-line implementation *error-output*)
               (write-string (get-output-stream-string stderr)
                             *error-output*)
               (sb-ext:exit :code 1))
        (write-line ": SUCCESS"))))