Changeset 9051 for trunk/source/lib
- Timestamp:
- Apr 8, 2008, 4:12:46 AM (13 years ago)
- Location:
- trunk/source/lib
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/lib/ccl-export-syms.lisp
r8973 r9051 611 611 xload-level-0 612 612 rebuild-ccl 613 test-ccl 613 614 defglobal 614 615 -
trunk/source/lib/compile-ccl.lisp
r7925 r9051 591 591 t)))) 592 592 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.