From a3dace276a82b86e95e9eef45b572fa4bf861e5e Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Wed, 2 Oct 2013 03:04:47 -0400 Subject: [PATCH] Fix some tests on XCL (!) --- test/run-tests.sh | 2 +- test/test-concatenate-source.script | 3 +-- uiop/filesystem.lisp | 5 +++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/test/run-tests.sh b/test/run-tests.sh index a251d158..c820de45 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -216,7 +216,7 @@ case "$lisp" in eval="-eval" ;; xcl) command="${XCL:-xcl}" - flags="--no-userinit --no-siteinit" + flags="--no-userinit --no-siteinit --noinform" eval="--eval" ;; *) echo "Unsupported lisp: $1" >&2 diff --git a/test/test-concatenate-source.script b/test/test-concatenate-source.script index 03e3ebec..2571ecd7 100644 --- a/test/test-concatenate-source.script +++ b/test/test-concatenate-source.script @@ -1,7 +1,5 @@ ;;; -*- Lisp -*- - - (def-test-system :test-concatenate-source :depends-on (:file3-only) :components @@ -18,6 +16,7 @@ (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 diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 0078f684..1c762ab5 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -544,8 +544,9 @@ in an atomic way if the implementation allows." #+sbcl #.(if-let (dd (find-symbol* :delete-directory :sb-ext nil)) `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname))) - #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl) - (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera xcl + #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname))) + #-(or abcl allegro clisp clozure cmu cormanlisp digitool ecl gcl lispworks sbcl scl xcl) + (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera (defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error)) "Delete a directory including all its recursive contents, aka rm -rf. -- GitLab