From 0c3d4aa7f3d5daf59289a8bc8ab48fc3be693504 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Thu, 7 May 2015 20:54:36 -0400 Subject: [PATCH] Add with-expected-failures in tests for bugs in underlying implementation. --- test/asdf-pathname-test.script | 2 +- test/script-support.lisp | 12 ++++++++- test/test-compile-file-failure.script | 12 ++++----- test/test-concatenate-source.script | 10 ++++---- test/test-deferred-warnings.script | 33 +++++++++++------------- test/test-encodings.script | 15 ++++++++--- test/test-operation-classes.script | 6 ++--- test/test-run-program.script | 7 +++--- test/test-sysdef-asdf.script | 2 +- test/test-try-recompiling-1.script | 6 +---- test/test-urls-1.script | 1 - test/test-urls-2.script | 1 - test/test-utilities.script | 36 ++++++++++++++------------- 13 files changed, 76 insertions(+), 67 deletions(-) diff --git a/test/asdf-pathname-test.script b/test/asdf-pathname-test.script index e7460bcd..e967420d 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 705d780d..39731bbe 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 1cb0e307..bab990f3 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 2571ecd7..be49f2b2 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 110f842a..adab6258 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 0d9aa54d..28458802 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 e780f327..bbcf83ca 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 227b1f53..db7f42d8 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 63cae219..1c1a2a87 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 d2cc4658..6b3565ec 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 0da1d9bf..9d5a5283 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 f7b1435b..37e39580 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 5002cbff..2e0f0bfd 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))) -- GitLab