Apr 9, 2008, 11:48:46 PM (13 years ago)

Add CCL:TEST-CCL - runs the gcl test suite (checking it out into ccl:tests;
if necessary). This will print out a bunch of warnings early on (for now),
then sit there for a while (about 3 mins on a MacBook? Pro) and finally
report "No tests failed".

Propagate assorted small fixes from trunk:

r8996 - fix case of spurious defvar warning
r9027 - check arg count before deciding to use builtin-call
r9046 - small fix for ~@:C
r9047 - report a TYPE-ERROR when make-broadcast-stream is given a non-output-stream
r9048 - Make make-file-stream rejected wildcarded pathnames. Various tweaks to make

meta-. work when using pathnames relative to the file system's "current directory".

r9049 - make defclass check for illegal class options
r9052 - Don't constant-fold if arg count is obviously wrong.
r9059 - Try harder to do function calls as function calls when (OPTIMIZE (SAFETY 3))

is in effect.

r9060, r9061 - CTYPE-SUBTYPE: try harder in some cases.
r9068, r9069, r9103, r9104 - PPC2-REF-SYMBOL-VALUE: force boundp checks unless

*ppc2-reckless* (same policy as x86; the per-thread binding lookup is generally
more expensive than boundp trap these days.). Unless skipping boundp check, don't
ignore unused result (so we can error when safety is 3, mostly.)

1 edited


  • branches/working-0711/ccl/lib/compile-ccl.lisp

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