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