Commit 0c3d4aa7 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Add with-expected-failures in tests for bugs in underlying implementation.

parent bcc37312
......@@ -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)
......@@ -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)
......
......@@ -9,9 +9,9 @@
t)
(compile-file-error () nil)))
#-gcl
(assert (handler-case
(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)))
(compile-file-error () t))))
......@@ -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
(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")))
(resolve-output "asdf/test/test-concatenate-source--all-systems.lisp"))))
(assert-pathnames-equal
(output-files mcso sys)
(input-files mccso sys))
......
......@@ -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
(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)))
(:no-error (&rest values) (DBG :utdf1 values) nil))))
#-clozure
(assert
(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)))
(:no-error (&rest values) (DBG :ustdf1 values) nil))))
(errors #+(or allegro clozure) compile-file-error
#+(or cmu scl) compile-warned-error
......
......@@ -77,15 +77,22 @@
(load-system :asdf-encodings)
#-lispworks
(with-encoding-test (:latin-2)
(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"))))
: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
......
......@@ -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))
......
......@@ -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))
......
......@@ -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)))
......
......@@ -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))
......
;;; -*- Lisp -*-
#+scl
(require :http-library)
......
;;; -*- Lisp -*-
#+scl
(require :http-library)
......
......@@ -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,8 +321,8 @@
(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
(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")
......@@ -329,7 +331,7 @@
: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)))))
p))))))
(DBG :ensure-gethash)
(let ((h (make-hash-table :test 'equal)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment