Commit 71f75b67 authored by Karsten Poeck's avatar Karsten Poeck Committed by Robert Goldman

Mark failing test for clasp

parent 797d8cea
......@@ -53,7 +53,9 @@
(leave-test "CLISP 2.49 translates logical pathnames in *LOAD-PATHNAME*" 0))
(defparameter sys (find-system :test-logical-pathname))
(assert (logical-pathname-p (component-pathname sys)))
(with-expected-failure (#+clasp "Clasp fails here")
(assert (logical-pathname-p (component-pathname sys))))
(assert (logical-pathname-p (system-source-file sys)))
(DBG "Done")
......@@ -37,7 +37,8 @@
(DBG "Testing true via run-shell-command")
(assert-equal 0 (run-shell-command "exit 0"))
(DBG "Testing false via run-shell-command")
(assert-equal 1 (run-shell-command "exit 1"))
(with-expected-failure (#+clasp "clasp fails on (EXT:SYSTEM \"exec < /dev/null >> /dev/null 2>> /dev/null ; exit 0\")")
(assert-equal 1 (run-shell-command "exit 1")))
(DBG "Testing bad shell command via run-shell-command")
(unless (< 0 (run-shell-command "./bad-shell-command"))
(error "Failed to capture exit status indicating shell command failure.")))
......@@ -62,28 +63,37 @@
#+os-windows '(("cmd /c exit 0" . 0) ("cmd /c exit 1" . 1))
:do (loop
:for force-shell :in '(t nil)
:do (assert-equal `(nil nil ,exit-code)
(multiple-value-list
(run-program program
:ignore-error-status t
:force-shell force-shell
:output :interactive)))))
:do (if (string= program "true")
(assert-equal `(nil nil ,exit-code)
(multiple-value-list
(run-program program
:ignore-error-status t
:force-shell force-shell
:output :interactive)))
(with-expected-failure (#+clasp "Fails for false")
(assert-equal `(nil nil ,exit-code)
(multiple-value-list
(run-program program
:ignore-error-status t
:force-shell force-shell
:output :interactive)))))))
#+(and ecl os-windows)
(DBG "Test skipped on ECL + Windows")
#-(and ecl os-windows)
(assert-equal
'("foo" "bar baz" 42)
(multiple-value-bind (o e c)
(run-program #+os-unix "cat ; echo bar baz >&2 ; exit 42"
#+os-windows "findstr \"^\" & echo bar baz >&2 & exit 42"
;; On some versions of windows, findstr hangs indefinitely
;; when passed input without a trailing newline
:input '("foo" :terpri t)
:output '(:string :stripped t) :error-output '(:string :stripped t)
:ignore-error-status t)
(DBG "aaa" o e c)
(list (dewindowize o) (dewindowize e) c)))
(with-expected-failure (#+clasp "Fails")
(assert-equal
'("foo" "bar baz" 42)
(multiple-value-bind (o e c)
(run-program #+os-unix "cat ; echo bar baz >&2 ; exit 42"
#+os-windows "findstr \"^\" & echo bar baz >&2 & exit 42"
;; On some versions of windows, findstr hangs indefinitely
;; when passed input without a trailing newline
:input '("foo" :terpri t)
:output '(:string :stripped t) :error-output '(:string :stripped t)
:ignore-error-status t)
(DBG "aaa" o e c)
(list (dewindowize o) (dewindowize e) c))))
#-(and ecl os-windows)
(assert-equal
'(("foo" "bar" "baz" "quux") nil 0)
......@@ -236,7 +246,8 @@
(DBG "Checking behavior on program success or failure")
(assert-equal '(nil nil 0) (multiple-value-list (run-program "true")))
(signals subprocess-error (run-program "false"))
(assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t)))
(with-expected-failure (#+clasp "Fails")
(assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t))))
(DBG "Tests with test-file")
(let ((tf (native-namestring (test-source "test-file"))))
......
......@@ -46,7 +46,8 @@
(setf state "Caught warning")))))
(clear-system "asdf")
(upgrade-asdf))
(assert-equal state "Caught warning"))
(with-expected-failure (#+clasp "Fails")
(assert-equal state "Caught warning")))
(DBG "2nd bogus attempt at loading same old ASDF: should ignore without a warning")
......@@ -68,7 +69,7 @@
:ignore-inherited-configuration))
(clear-system "asdf")
(with-asdf-session (:override t)
(with-expected-failure (#+xcl t) ;; expected-failure: XCL has trouble with the ASDF upgrade
(with-expected-failure (#+xcl t #+clasp t) ;; 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))))
......@@ -85,7 +86,7 @@
(assert (asdf/upgrade::upgrading-p))
(clear-system "asdf")
(reset-session)
(with-expected-failure (#+xcl t)
(with-expected-failure (#+xcl t #+clasp t)
;; expected-failure: XCL has trouble with the ASDF upgrade
(load-system :asdf)
(assert-equal (asdf-version) *current-version*)
......@@ -96,9 +97,10 @@
(DBG "Upgrading from an old-enough version should have redefined away the input-files method!")
(setf *ticks* 4)
(input-files 'load-op "asdf")
(assert-equal *ticks* 4)
;; It also cleared away previously defined systems
(assert (not (find-system "fooey" nil)))
(with-expected-failure (#+clasp t)
(assert-equal *ticks* 4)
;; It also cleared away previously defined systems
(assert (not (find-system "fooey" nil))))
(DBG "Actually upgrade, from a different but forward-compatible version")
......@@ -112,7 +114,8 @@
(DBG :input-files-after-2 o c
(tick)))
(input-files 'load-op "uiop")
(assert-equal *ticks* 12)
(with-expected-failure (#+clasp t)
(assert-equal *ticks* 12))
(with-expected-failure (#+xcl t)
;; expected-failure: XCL has trouble with the ASDF upgrade
(load-system :asdf))
......@@ -158,4 +161,5 @@
:do (push (format nil "In ~A expected:~%~A~A~%~%but found:~%~A~A~%~%~%"
file prefix expected prefix found)
errors))
:finally (when errors (error (reduce/strcat (reverse errors)))))
:finally (when errors (with-expected-failure (#+clasp t)
(error (reduce/strcat (reverse errors))))))
......@@ -309,11 +309,13 @@
(let ((new-file (subpathname *build-directory* "deleteme/a/1.x")))
(when (probe-file new-file)
(delete-file new-file))
(copy-file (system-source-file :asdf) new-file))
(with-expected-failure (#+clasp "(system-source-file :asdf) is nil")
(copy-file (system-source-file :asdf) new-file)))
(let ((new-file (subpathname *build-directory* "deleteme/a/b/2")))
(when (probe-file new-file)
(delete-file new-file))
(copy-file (system-source-file :asdf) new-file))
(with-expected-failure (#+clasp "(system-source-file :asdf) is nil")
(copy-file (system-source-file :asdf) new-file)))
(assert (directory-exists-p (subpathname *build-directory* "deleteme/a/b/c/")))
(assert (directory-exists-p (subpathname *build-directory* "deleteme/a/b/d/")))
(assert (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/")))
......@@ -335,14 +337,17 @@
(directory-b-no-slash (subpathname *build-directory* "deleteme/a/b")))
(assert (eq 'with-current-directory 'uiop:with-current-directory))
(with-current-directory (directory-a-no-slash)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/1.x"))))
(with-expected-failure (#+clasp T)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/1.x")))))
(with-current-directory (directory-b-no-slash)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/b/2")))
(assert-pathnames-equal
(sort (subdirectories (getcwd)) #'string< :key #'(lambda (x) (car (last (pathname-directory x)))))
(list (subpathname *build-directory* "deleteme/a/b/c/")
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/")))))
(with-expected-failure (#+clasp T)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/b/2"))))
(with-expected-failure (#+clasp T)
(assert-pathnames-equal
(sort (subdirectories (getcwd)) #'string< :key #'(lambda (x) (car (last (pathname-directory x)))))
(list (subpathname *build-directory* "deleteme/a/b/c/")
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/"))))))
(DBG "check to make sure SUBDIRECTORIES does list subdirectories")
......@@ -386,7 +391,10 @@
(assert (typep *last-char* 'base-char)))
(defun basify (s) (coerce s 'base-string))
(defun unbasify (s) (coerce s '(array character (*)))) ; on ECL, literals are base strings (!)
(defun unbasify (s)
#-clasp (coerce s '(array character (*)))
#+clasp (make-array (length s) :element-type 'character :initial-contents s)
) ; on ECL, literals are base strings (!) on clasp, literals are reduced to base-strings in all chars are base-chars
#+non-base-chars-exist-p
(progn
......@@ -482,7 +490,8 @@
(let ((s (get-optimization-settings)))
(loop :for q :in '(speed space safety debug) :do
#+mkcl (DBG :os i q s (assoc q s))
(assert-equal i (second (assoc q s))))))
(assert-equal i (second (assoc q s))))))
;;; The order does not seem to be significant, should better test that all values are the same
(assert-equal (get-optimization-settings) settings))
(DBG :standard-case-symbol-name)
......
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