root/trunk/build.lisp

;; -*- Lisp -*-

;; BKNR build script - Called by buildbot to build/test

(setf *compile-verbose* nil)
(setf *compile-print* nil)

#+sbcl
(require "ASDF")
(load (compile-file "thirdparty/asdf/asdf.lisp"))

(defpackage :build (:use :cl))
(in-package :build)

(format t "Building with ~A ~A.~%Features: ~S~%"
        (lisp-implementation-type) (lisp-implementation-version)
        *features*)

#+openmcl
(setf ccl::*defmethod-declare-all-arguments-ignorable* t)

(defun setup-registry (directory-path)
  (flet ((valid-p (asd-pathname)
           (and (not (member "_darcs" (pathname-directory asd-pathname) :test #'equal))
                (not (member "asd" (pathname-directory asd-pathname) :test #'equal)))))
    (format t "; adding components under ~A to asdf registry~%" directory-path)
    (mapc (lambda (asd-pathname)
            (when (valid-p asd-pathname)
              (let ((member (member (file-namestring asd-pathname) asdf:*central-registry*
                                    :key #'(lambda (entry) (if (or (stringp entry) (pathnamep entry))
                                                               (file-namestring entry)
                                                               nil))
                                    :test #'equal)))
                (assert (not member)
                        nil
                        "Found ~a,~%but ~a~%already exists in the asdf registry."
                        asd-pathname (first member))
                (push asd-pathname asdf:*central-registry*))))
          (directory (merge-pathnames #p"**/*.asd" directory-path)))))

(defun exit (code)
  #+sbcl
  (sb-unix:unix-exit code)
  #+openmcl
  (ccl:quit code)
  #+cmu
  (unix:unix-exit code))

#+openmcl
(defvar *initial-shared-libraries* (copy-list ccl::*shared-libraries*))

#+openmcl
(defun dump-image (&optional (image-name "bknr-sbcl.image"))
  (format t "~&;;; --- dumping image ~A~%" image-name)
  (dolist (lib ccl::*shared-libraries*)
    (ignore-errors
      (ccl::close-shared-library lib)))
  (setf ccl::*shared-libraries* *initial-shared-libraries*)
  (ccl:save-application "bknr-ccl.image"))

#+sbcl
(defun dump-image (&optional (image-name "bknr-sbcl.image"))
  (format t "~&;;; --- dumping image ~A~%" image-name)
  (sb-ext:save-lisp-and-die "bknr-sbcl.image"))

(setup-registry (probe-file *default-pathname-defaults*))

(dolist (system '(:bknr.web
                  :quickhoney
                  :bos.web
                  :bos.test
                  :lisp-ecoop
                  :bknr.datastore.test
                  :bknr.indices.test
                  :bknr.skip-list.test
                  :html-match
                  :html-match.test
                  :yason
                  :cl-gd-test
                  :cl-ppcre-test
                  :kmrcl-tests
                  :flexi-streams
                  :flexi-streams-test
                  :uffi
                  #+(or) :uffi-tests
                  :screamer
                  :cl-fad
                  :xhtmlgen-test
                  #+(or) :cffi-tests
                  #+(or) :usocket
                  #+(or) :usocket-test
                  #+(or) :uffi-test
                  #+(or) :usocket-test
                  ))
  (format t "~&;;; --- loading system ~A~%" system)
  (asdf:oos 'asdf:load-op system :verbose nil))

;; For some reason, automatic loading of the GD library does not work
;; on FreeBSD/i386 with SBCL.  This temporary fix hopefully cures the
;; problem for the moment:
#+(and sbcl freebsd x86)
(progn
  (eval (read-from-string "(uffi:load-foreign-library \"/usr/local/lib/libgd.so\")"))
  (eval (read-from-string "(uffi:load-foreign-library \"/usr/local/lib/cl-gd-glue.so\")")))

(defun build ()
  (exit 0))

(defmacro run-tests (&body forms)
  `(let (any-failed)
     ,@(mapcar (lambda (form)
                 `(progn
                    (format t "~&====================== RUNNING ~S~%"
                            ',form)     ; quoted
                    (let ((failed (null ,form)))
                      (format t "~&====================== ~S ~A~%~%"
                              ',form (if failed "FAILED xxxxx" "SUCCEEDED"))
                      (setf any-failed (or any-failed failed)))))
               forms)
     (exit (if any-failed 1 0))))

#+(or)
(defun cl-ppcre-run-no-failures-p ()
  (let ((expected "..........
..........
..........
..........
..........
..........
......
 662 (\"a\" =~ /((a)*)*/):
   \\2: expected NIL but got \"a\"
....
.........
 790 (\"babc\" =~ /^(b*|ba){1,2}bc/):
   \\1: expected \"\" but got \"ba\"
.
..........
..........
..........
..........
..........
..........
...
1439 (\"dbaacb\" =~ /(?<!(c|d))[ab]/):
   \\1: expected NIL but got \"d\"
.......
..........
.."))
    (string= expected
             (with-output-to-string (to-string)
               (let ((*standard-output* (make-broadcast-stream *standard-output* to-string)))
                 (cl-ppcre-test:test))))))

(defun cl-gd-run-no-failures-p ()
  (flet ((test% ()
           (let ((result t))
             (loop for i from 1 to 19 do
                  (if (member i '(7 8 15 17))
                      (format t "Skipping Test ~A~%" i)
                      (handler-case
                          (let ((r (let ((test-function
                                          (intern (format nil "TEST-~3,'0d" i)
                                                  :cl-gd-test)))
                                     (funcall test-function))))
                            (format t "Test ~A ~:[failed~;succeeded~].~%" i r)
                            (unless r (setf result nil)))
                        (error (condition)
                          (format t "Test ~A failed with the following error: ~A~%"
                                  i condition)
                          (setf result nil))))
                  (force-output))
             (format t "Done.~%")
             result)))
    (test%)))

(defun flexi-streams-no-failures-p ()
  (format t "(we are clipping verbose output here)~%")
  (let ((result (with-output-to-string (*error-output*)
                  (flexi-streams-test::run-tests))))
    (cond
      ((ppcre:scan "All\\s+\\d+\\s+tests passed" result) t)
      ((ppcre:scan "\\d+\\s+of\\s+\\d+\\s+tests failed" result) nil)
      (t (warn "could not interpret flexi-streams test result")
         nil))))

(defun fiveam-run-no-failures-p (test)
  (let ((results (5am::run test)))
    (5am:explain! results)
    (zerop (nth-value 8 (5am::partition-results results)))))

(defun test ()
  (cl-gd::load-gd-glue)
  (format t "~&;;; --- running tests~%")
  (run-tests
   #+(or)
   (cl-ppcre-run-no-failures-p)    
   (cl-gd-run-no-failures-p)
   #+(or)
   (flexi-streams-no-failures-p)
   (unit-test:run-all-tests)
   (rt:do-tests)
   (fiveam-run-no-failures-p :bknr.datastore)
   #-darwin (fiveam-run-no-failures-p :bos.test)
   (progn #+(or) (fiveam-run-no-failures-p :it.bese.FiveAM)
          (warn "skipping :it.bese.FiveAM tests")
          t)
   ))