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