Changeset 9051


Ignore:
Timestamp:
Apr 8, 2008, 4:12:46 AM (12 years ago)
Author:
gz
Message:

Add ccl:test-ccl, to run test suite

Location:
trunk/source/lib
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/ccl-export-syms.lisp

    r8973 r9051  
    611611     xload-level-0
    612612     rebuild-ccl
     613     test-ccl
    613614     defglobal
    614615
  • trunk/source/lib/compile-ccl.lisp

    r7925 r9051  
    591591        t))))
    592592
    593                            
     593(defmacro with-preserved-working-directory ((&optional dir) &body body)
     594  (let ((wd (gensym)))
     595    `(let ((,wd (mac-default-directory)))
     596       (unwind-protect
     597            (progn
     598              ,@(when dir `((cwd ,dir)))
     599              ,@body)
     600         (cwd ,wd)))))
     601
     602(defun ensure-tests-loaded (&key force full)
     603  (unless (and (find-package "REGRESSION-TEST") (not force))
     604    (if (probe-file "ccl:tests;ansi-tests;")
     605      (when full
     606        (cwd "ccl:tests;")
     607        (run-program "svn" '("update")))
     608      (let* ((svn (probe-file "ccl:.svn;entries"))
     609             (repo (and svn
     610                        (with-open-file (s svn)
     611                          (loop as line =  (read-line s nil) while line
     612                             do (when (search "://" line)
     613                                  (setq line (read-line s))
     614                                  (return (and (search "://" line) line)))))))
     615             (s (make-string-output-stream)))
     616        (when repo
     617          (format t "~&Checking out test suite into ccl:tests;~%")
     618          (cwd "ccl:")
     619          (multiple-value-bind (status exit-code)
     620              (external-process-status
     621               (run-program "svn" (list "checkout" (format nil "~a/trunk/tests" repo) "tests")
     622                            :output s
     623                            :error s))
     624            (unless (and (eq status :exited)
     625                         (eql exit-code 0))
     626              (error "Failed to check out test suite: ~%~a" (get-output-stream-string s)))))))
     627    (cwd "ccl:tests;ansi-tests;")
     628    (run-program "make" '("-k" "clean"))
     629    (map nil 'delete-file (directory "*.*fsl"))
     630    ;; Muffle the typecase "clause ignored" warnings, since there is really nothing we can do about
     631    ;; it without making the test suite non-portable across platforms...
     632    (handler-bind ((warning (lambda (c)
     633                              (when (and (typep c 'compiler-warning)
     634                                         (eq (compiler-warning-warning-type c) :program-error)
     635                                         (typep (car (compiler-warning-args c)) 'simple-warning)
     636                                         (or
     637                                          (string-equal
     638                                           (simple-condition-format-control (car (compiler-warning-args c)))
     639                                           "Clause ~S ignored in ~S form - shadowed by ~S .")
     640                                          ;; Might as well ignore these as well, they're intentional.
     641                                          (string-equal
     642                                           (simple-condition-format-control (car (compiler-warning-args c)))
     643                                           "Duplicate keyform ~s in ~s statement.")))
     644                                (muffle-warning c)))))
     645      ;; This loads the infrastructure
     646      (load "ccl:tests;ansi-tests;gclload1.lsp")
     647      ;; This loads the actual tests
     648      (load "ccl:tests;ansi-tests;gclload2.lsp"))))
     649
     650(defun test-ccl (&key force full verbose (catch-errors t))
     651  (with-preserved-working-directory ()
     652    (ensure-tests-loaded :force force :full full)
     653    (cwd "ccl:tests;ansi-tests;")
     654    (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))
     655          (*suppress-compiler-warnings* t)
     656          (*print-catch-errors* nil))
     657      (time (funcall do-tests :verbose verbose :compile t :catch-errors catch-errors)))
     658    ;; Ok, here we would run any of our own tests.
     659    ))
Note: See TracChangeset for help on using the changeset viewer.