diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script index e7460bcd0b3ac47b1d9e6084b455034f00f0b220..e967420dc97b19e6bf33faf62fcfa3ba3a870117 100644 --- a/test/asdf-pathname-test.script +++ b/test/asdf-pathname-test.script @@ -459,7 +459,7 @@ (assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-1)))) (assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-2)))) -#-gcl +#-gcl ;; expected-failure: GCL crashes badly (assert (test-component-pathnames :delete-host t :support-string-pathnames nil)) (test-pathname-parsing) diff --git a/test/script-support.lisp b/test/script-support.lisp index 705d780da058bd1304016768c45d2c7e63c13979..39731bbe5fa446370d53a333d336d4f92151aafe 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -15,7 +15,7 @@ Some constraints: (:export #:asym #:acall #:asymval #:*test-directory* #:*asdf-directory* #:*build-directory* #:*implementation* - #:deftest #:is #:signals + #:deftest #:is #:signals #:errors #:with-expected-failure #:assert-compare #:assert-equal #:assert-pathname-equal #:assert-pathnames-equal #:hash-table->alist #:load-asdf #:maybe-compile-asdf @@ -132,6 +132,16 @@ Some constraints: (format *error-output* "~&Checking whether ~S signals error ~S~%" ',sexp ',condition) (finish-output *error-output*) (assert-equal ',condition (type-of (nth-value 1 (ignore-errors ,sexp)))))) +(defmacro with-expected-failure ((&optional condition) &body body) + `(call-with-expected-failure ,condition (lambda () ,@body))) +(defun call-with-expected-failure (condition thunk) + (if condition + (handler-case (funcall thunk) + (:no-error (&rest x) (declare (ignore x)) (error "Unexpected success: ~A" condition)) + (t (x) (declare (ignore x)) t)) + (funcall thunk))) + + ;;; Helpful for debugging (defun pathname-components (p) diff --git a/test/test-compile-file-failure.script b/test/test-compile-file-failure.script index 1cb0e30760f7d0a01eda3ee3af90779945897430..bab990f3a6cbc06404d7f21ac0914057f568725b 100644 --- a/test/test-compile-file-failure.script +++ b/test/test-compile-file-failure.script @@ -9,9 +9,9 @@ t) (compile-file-error () nil))) -#-gcl -(assert (handler-case - (let ((*compile-file-failure-behaviour* :error)) - (load-system 'test-compile-file-failure :force t) - nil) - (compile-file-error () t))) +(with-expected-failure (#+gcl "GCL failure to report compile-file error") + (assert (handler-case + (let ((*compile-file-failure-behaviour* :error)) + (load-system 'test-compile-file-failure :force t) + nil) + (compile-file-error () t)))) diff --git a/test/test-concatenate-source.script b/test/test-concatenate-source.script index 2571ecd75d0fd8eb0415316e5bd2de1744ef90ee..be49f2b2e1f268e0089b0d1880957fa454e481f3 100644 --- a/test/test-concatenate-source.script +++ b/test/test-concatenate-source.script @@ -16,11 +16,11 @@ (assert-pathnames-equal (input-files mcso sys) (loop :for n :in '(3 1 2) :collect (test-source (format nil "file~D.lisp" n)))) -#-xcl ;; xcl has buggy translate-pathname -(assert-pathname-equal - (output-file mcso sys) - (apply-output-translations - (resolve-output "asdf/test/test-concatenate-source--all-systems.lisp"))) +(with-expected-failure (#+xcl "xcl has buggy translate-pathname") + (assert-pathname-equal + (output-file mcso sys) + (apply-output-translations + (resolve-output "asdf/test/test-concatenate-source--all-systems.lisp")))) (assert-pathnames-equal (output-files mcso sys) (input-files mccso sys)) diff --git a/test/test-deferred-warnings.script b/test/test-deferred-warnings.script index 110f842a58970c460727533f4b221ff1d2a64596..adab6258a394941c3d6ba98f7eebba9d76efa4c6 100644 --- a/test/test-deferred-warnings.script +++ b/test/test-deferred-warnings.script @@ -76,27 +76,24 @@ (load-system :use-setf-then-defun-foo) -;;#+clozure (format t "~S~%" asdf/lisp-build::*warnings*) -;;#+clozure (trace load compile-file check-deferred-warnings check-lisp-compile-warnings) - ;; FIXME: on CCL, the defmacro warning is found while loading the defmacro fasl. ;; We should probably beef up the detection in reify-deferred-warnings, ;; possibly file a bug. -#-clozure -(assert - (handler-case - (load-system :use-then-defmacro-foo :force t) - ((or compile-file-error compile-warned-error) () t) - ;;(t (c) (DBG :utdf0 c)) - (:no-error (&rest values) (DBG :utdf1 values) nil))) - -#-clozure -(assert - (handler-case - (load-system :use-setf-then-defsetf-foo :force t) - ((or compile-file-error compile-warned-error) () t) - ;;(t (c) (DBG :ustdf0 c)) - (:no-error (&rest values) (DBG :ustdf1 values) nil))) +(with-expected-failure (#+clozure "CCL warns while loading, not compiling") + (assert + (handler-case + (load-system :use-then-defmacro-foo :force t) + ((or compile-file-error compile-warned-error) () t) + ;;(t (c) (DBG :utdf0 c)) + (:no-error (&rest values) (DBG :utdf1 values) nil)))) + +(with-expected-failure (#+clozure "CCL warns while loading, not compiling") + (assert + (handler-case + (load-system :use-setf-then-defsetf-foo :force t) + ((or compile-file-error compile-warned-error) () t) + ;;(t (c) (DBG :ustdf0 c)) + (:no-error (&rest values) (DBG :ustdf1 values) nil)))) (errors #+(or allegro clozure) compile-file-error #+(or cmu scl) compile-warned-error diff --git a/test/test-encodings.script b/test/test-encodings.script index 0d9aa54d31b023536d042a1ba39ed7d221e6fa13..284588021a75c1d2aa3728492dd7f4bac1630364 100644 --- a/test/test-encodings.script +++ b/test/test-encodings.script @@ -77,15 +77,22 @@ (load-system :asdf-encodings) -#-lispworks -(with-encoding-test (:latin-2) - (def-test-system :test-encoding-implicit-autodetect - :components ((:file "lambda")))) + +(with-expected-failure (#+lispworks "LispWorks doesn't have LATIN-2" + #+ecl "ECL recently broke its encoding support") ;; Check that it indeed still is broken before we punt. + (with-encoding-test (:latin-2) + (def-test-system :test-encoding-implicit-autodetect + :components ((:file "lambda"))))) + +#+ecl +(leave-test "ECL recently broke its encoding support" 0) + #+sbcl (with-encoding-test (:koi8-r) (def-test-system :test-encoding-explicit-koi8-r :components ((:file "lambda" :encoding :koi8-r)))) + (with-encoding-test (:utf-8) (def-test-system :test-file-encoding-u8 :encoding :latin-1 diff --git a/test/test-operation-classes.script b/test/test-operation-classes.script index e780f327b3630037a81b820785c109dbaa73820a..bbcf83ca21a1c6aa1c3aeed018ceaa8c80cf9a4b 100644 --- a/test/test-operation-classes.script +++ b/test/test-operation-classes.script @@ -52,9 +52,9 @@ (signals operation-definition-warning (make-instance 'my-unupdated-operation)) -#-gcl -(signals operation-definition-error - (make-instance 'my-incoherent-operation)) +(with-expected-failure (#+gcl "GCL has trouble with CLOS?") + (signals operation-definition-error + (make-instance 'my-incoherent-operation))) (assert (make-instance 'my-good-operation)) diff --git a/test/test-run-program.script b/test/test-run-program.script index 227b1f536c46ff2eaa4a7921af4cefb2176e71a4..db7f42d8518a8cf4aed0f971cb2a66f7165d25fc 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -37,7 +37,8 @@ #+os-unix (progn - (chdir *test-directory*) + (with-expected-failure (#+xcl "no chdir") + (chdir *test-directory*)) (DBG "Testing good shell command in current directory via run-shell-command") (assert-equal 0 (run-shell-command "./good-shell-command")) @@ -70,7 +71,6 @@ (let ((*verbose-out* s)) (run-shell-command "echo ~A 1" "ok"))))) ok1) - #-ecl (assert-equal (dewindowize (stripln @@ -182,8 +182,7 @@ Testing run-program (assert-equal (nl "Hello World") (run-program '("echo" "Hello World") :output :string)) (assert-equal (nl "Hello World") (run-program "echo Hello World" :output :string)) - ;; Test that run-program fails properly with an - ;; empty program string + ;; Test that run-program fails properly with an empty program string #+(or clozure (and allegro os-unix) cmu (and lispworks os-unix) sbcl scl) (signals error (run-program '("") :output :lines)) diff --git a/test/test-sysdef-asdf.script b/test/test-sysdef-asdf.script index 63cae2192bfcfa227dd8f06353cb71669ed8e6da..1c1a2a87af3a162a88bdfdeaef5f57e125481f8a 100644 --- a/test/test-sysdef-asdf.script +++ b/test/test-sysdef-asdf.script @@ -50,7 +50,7 @@ ;; But if we cheat on our version, that should work (setf asdf::*asdf-version* "3.0") (asdf::clear-defined-system "asdf") -#-xcl ;; XCL has trouble with the ASDF upgrade +#-xcl ;; expected-failure: XCL has trouble with the ASDF upgrade (load-system :asdf) (assert-pathname-equal (subpathname *asdf-directory* "asdf.asd") (system-source-file (find-system :asdf))) diff --git a/test/test-try-recompiling-1.script b/test/test-try-recompiling-1.script index d2cc46584b8aba5adf28865b96aa7e8c61b2825f..6b3565ec2884d1c038dc35fbe49504029564e5fb 100644 --- a/test/test-try-recompiling-1.script +++ b/test/test-try-recompiling-1.script @@ -2,8 +2,6 @@ ;;; test asdf:try-recompiling restart - - (defparameter *caught-error* nil) (delete-file-if-exists (test-fasl "try-recompiling-1")) @@ -17,9 +15,7 @@ :asdf) (assert (eq mode :external)) (let ((restart (find-restart name c))) - #+(or) - ;; debug - (print (list c restart (compute-restarts c))) + ;;(DBG :foo c restart (compute-restarts c)) (when restart (invoke-restart restart))))))) (oos 'load-op 'try-recompiling-1)) diff --git a/test/test-urls-1.script b/test/test-urls-1.script index 0da1d9bf64d7e898369a0d86a1cb69ba1089cd05..9d5a5283aacfa6cc901e06a6933edb5de812d036 100644 --- a/test/test-urls-1.script +++ b/test/test-urls-1.script @@ -1,6 +1,5 @@ ;;; -*- Lisp -*- - #+scl (require :http-library) diff --git a/test/test-urls-2.script b/test/test-urls-2.script index f7b1435b6a38daa5b57d0864576554a9d15ad165..37e39580cd7ec30f26d91ab46c2e8fab6f9cb1fe 100644 --- a/test/test-urls-2.script +++ b/test/test-urls-2.script @@ -1,6 +1,5 @@ ;;; -*- Lisp -*- - #+scl (require :http-library) diff --git a/test/test-utilities.script b/test/test-utilities.script index 5002cbff8a7a5515efdaa74266cb6ff8dbbf2a3e..2e0f0bfdf295c7d91d51fd6dcdff5da7c0c470dd 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -7,12 +7,14 @@ :output '(:string :stripped t)) :ensure-directory t)) -(chdir *asdf-directory*) -(assert (pathname-equal *asdf-directory* (getcwd))) -(assert (pathname-equal *asdf-directory* (getcwd-from-run-program))) -(assert (probe-file* "asdf.asd")) - -(chdir *test-directory*) +(with-expected-failure (#+xcl "chdir unsupported") + (chdir *asdf-directory*) + (assert (pathname-equal *asdf-directory* (getcwd))) + (assert (pathname-equal *asdf-directory* (getcwd-from-run-program))) + (assert (probe-file* "asdf.asd"))) + +(with-expected-failure (#+xcl "chdir unsupported") + (chdir *test-directory*)) (assert (pathname-equal *test-directory* (getcwd))) (assert (pathname-equal *test-directory* (getcwd-from-run-program))) (assert (probe-file* "test-utilities.script")) @@ -319,17 +321,17 @@ (assert-equal (read-file-lines pn2) '("Hello, World")) (delete-file pn2)) -#-gcl ;; BUG in GCL compiling the WTF internal loop. Works if loaded without compiling. -(assert - (not (probe-file - (let ((s 'outer-s)) - (with-temporary-file (:stream s :pathname p :direction :io :prefix "WTF3") - (assert (open-stream-p s)) - (println "Same thing with :close-stream" s) - :close-stream - (assert-equal s 'outer-s) ;; the stream s (1) has been closed and (2) is no longer in scope. - (assert-equal (read-file-lines p) '("Same thing with :close-stream")) - p))))) +(with-expected-failure (#+gcl "BUG in GCL compiling the WTF internal loop. Works if loaded without compiling.") + (assert + (not (probe-file + (let ((s 'outer-s)) + (with-temporary-file (:stream s :pathname p :direction :io :prefix "WTF3") + (assert (open-stream-p s)) + (println "Same thing with :close-stream" s) + :close-stream + (assert-equal s 'outer-s) ;; the stream s (1) has been closed and (2) is no longer in scope. + (assert-equal (read-file-lines p) '("Same thing with :close-stream")) + p)))))) (DBG :ensure-gethash) (let ((h (make-hash-table :test 'equal)))