Changeset 15412


Ignore:
Timestamp:
Jun 11, 2012, 5:21:28 PM (7 years ago)
Author:
gb
Message:

(TEST-CCL :EXHAUSTIVE T) runs the test suite a all optimization settings.

File:
1 edited

Legend:

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

    r15305 r15412  
    806806         (cwd ,wd)))))
    807807
    808 (defun ensure-tests-loaded (&key force update ansi ccl)
     808(defun ensure-tests-loaded (&key force update ansi ccl (load t))
    809809  (unless (and (find-package "REGRESSION-TEST") (not force))
    810810    (if (probe-file "ccl:tests;ansi-tests;")
     
    833833    (run-program "make" '("-k" "clean") :output t)
    834834    (map nil 'delete-file (directory "*.*fsl"))
    835     ;; Muffle the typecase "clause ignored" warnings, since there is really nothing we can do about
    836     ;; it without making the test suite non-portable across platforms...
    837     (handler-bind ((warning (lambda (c)
    838                               (if (typep c 'shadowed-typecase-clause)
    839                                 (muffle-warning c)
    840                                 (when (let ((w (or (and (typep c 'compiler-warning)
    841                                                         (eq (compiler-warning-warning-type c) :program-error)
    842                                                         (car (compiler-warning-args c)))
    843                                                    c)))
    844                                         (or (typep (car (compiler-warning-args c))
    845                                                         'shadowed-typecase-clause)
    846                                             (and (typep w 'simple-warning)
    847                                                  (or
    848                                                   (string-equal
    849                                                    (simple-condition-format-control w)
    850                                                    "Clause ~S ignored in ~S form - shadowed by ~S .")
    851                                                   ;; Might as well ignore these as well, they're intentional.
    852                                                   (string-equal
    853                                                    (simple-condition-format-control w)
    854                                                    "Duplicate keyform ~s in ~s statement.")))))
    855                                   (muffle-warning c))))))
    856       ;; This loads the infrastructure
    857       (load "ccl:tests;ansi-tests;gclload1.lsp")
    858       ;; This loads the actual tests
    859       (let ((redef-var (find-symbol "*WARN-IF-REDEFINE-TEST*" :REGRESSION-TEST)))
    860         (progv (list redef-var) (list (if force nil (symbol-value redef-var)))
    861           (when ansi
    862             (load "ccl:tests;ansi-tests;gclload2.lsp"))
    863           ;; And our own tests
    864           (when ccl
    865             (load "ccl:tests;ansi-tests;ccl.lsp")))))))
     835    (when load
     836      ;; Muffle the typecase "clause ignored" warnings, since there is really nothing we can do about
     837      ;; it without making the test suite non-portable across platforms...
     838      (handler-bind ((warning (lambda (c)
     839                                (if (typep c 'shadowed-typecase-clause)
     840                                  (muffle-warning c)
     841                                  (when (let ((w (or (and (typep c 'compiler-warning)
     842                                                          (eq (compiler-warning-warning-type c) :program-error)
     843                                                          (car (compiler-warning-args c)))
     844                                                     c)))
     845                                          (or (typep (car (compiler-warning-args c))
     846                                                     'shadowed-typecase-clause)
     847                                              (and (typep w 'simple-warning)
     848                                                   (or
     849                                                    (string-equal
     850                                                     (simple-condition-format-control w)
     851                                                     "Clause ~S ignored in ~S form - shadowed by ~S .")
     852                                                    ;; Might as well ignore these as well, they're intentional.
     853                                                    (string-equal
     854                                                     (simple-condition-format-control w)
     855                                                     "Duplicate keyform ~s in ~s statement.")))))
     856                                    (muffle-warning c))))))
     857        ;; This loads the infrastructure
     858        (load "ccl:tests;ansi-tests;gclload1.lsp")
     859        ;; This loads the actual tests
     860        (let ((redef-var (find-symbol "*WARN-IF-REDEFINE-TEST*" :REGRESSION-TEST)))
     861          (progv (list redef-var) (list (if force nil (symbol-value redef-var)))
     862            (when ansi
     863              (load "ccl:tests;ansi-tests;gclload2.lsp"))
     864            ;; And our own tests
     865            (when ccl
     866              (load "ccl:tests;ansi-tests;ccl.lsp"))))))))
     867
    866868
    867869(defun test-ccl (&key force (update t) verbose (catch-errors t) (ansi t) (ccl t)
    868                       optimization-settings exit)
    869   (with-preserved-working-directory ()
    870     (let* ((*package* (find-package "CL-USER")))
    871       (with-global-optimization-settings ()
    872         (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl))
    873       (cwd "ccl:tests;ansi-tests;")
    874       (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))
    875             (failed (find-symbol "*FAILED-TESTS*" "REGRESSION-TEST"))
    876             (*print-catch-errors* nil))
    877         (prog1
    878             (time (funcall do-tests :verbose verbose :compile t
    879                            :catch-errors catch-errors
    880                            :optimization-settings (or optimization-settings '((speed 1) (space 1) (safety 1) (debug 1) (compilation-speed 1)))))
    881           ;; Clean up a little
    882           (map nil #'delete-file
    883                (directory (merge-pathnames *.fasl-pathname* "ccl:tests;ansi-tests;temp*"))))
    884         (let ((failed-tests (symbol-value failed)))
    885           (when exit
    886             (quit (if failed-tests 1 0)))
    887           failed-tests)))))
    888 
     870                      optimization-settings exit exhaustive)
     871  (if exhaustive
     872    (let* ((total-failures ()))
     873      (ensure-tests-loaded :update update :force nil :load nil)
     874      (dotimes (speed 4)
     875        (dotimes (space 4)
     876          (dotimes (safety 4)
     877            (dotimes (debug 4)
     878              (dotimes (compilation-speed 4)
     879                (let* ((optimization-settings `((speed ,speed)
     880                                                (space ,space)
     881                                                (safety ,safety)
     882                                                (debug ,debug)
     883                                                (compilation-speed ,compilation-speed))))
     884                  (format t "~&;Testing ~a at optimization settings~&;~s~&"
     885                          (lisp-implementation-version) optimization-settings)
     886                  (let* ((failures (test-ccl :force t
     887                                             :update nil
     888                                             :verbose verbose
     889                                             :catch-errors catch-errors
     890                                             :ansi ansi
     891                                             :ccl ccl
     892                                             :optimization-settings optimization-settings
     893                                             :exit nil)))
     894                    (when failures
     895                      (push (cons optimization-settings failures) total-failures)))))))))
     896      (if exit
     897        (quit (if total-failures 1 0))
     898        total-failures))
     899    (with-preserved-working-directory ()
     900      (let* ((*package* (find-package "CL-USER"))
     901             (*load-preserves-optimization-settings* t))
     902        (with-global-optimization-settings ()
     903          (proclaim `(optimize ,@optimization-settings))
     904          (ensure-tests-loaded :force force :update update :ansi ansi :ccl ccl)
     905          (cwd "ccl:tests;ansi-tests;")
     906          (let ((do-tests (find-symbol "DO-TESTS" "REGRESSION-TEST"))
     907                (failed (find-symbol "*FAILED-TESTS*" "REGRESSION-TEST"))
     908                (*print-catch-errors* nil))
     909            (prog1
     910                (time (funcall do-tests :verbose verbose :compile t
     911                               :catch-errors catch-errors
     912                               :optimization-settings (or optimization-settings '((speed 1) (space 1) (safety 1) (debug 1) (compilation-speed 1)))))
     913              ;; Clean up a little
     914              (map nil #'delete-file
     915                   (directory (merge-pathnames *.fasl-pathname* "ccl:tests;ansi-tests;temp*"))))
     916            (let ((failed-tests (symbol-value failed)))
     917              (when exit
     918                (quit (if failed-tests 1 0)))
     919              failed-tests)))))))
     920
Note: See TracChangeset for help on using the changeset viewer.