From 18e851e4b6d1be4e486fdc97a7249498d38cc5ed Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Thu, 20 Feb 2014 22:52:15 -0500 Subject: [PATCH] XCL cleanups(!): Downgrade *unspecific-pathname-type* due to XCL bug. Hush compile warnings. --- TODO | 4 ++++ bundle.lisp | 4 +++- plan.lisp | 2 +- uiop/pathname.lisp | 4 ++-- uiop/stream.lisp | 1 + 5 files changed, 11 insertions(+), 4 deletions(-) diff --git a/TODO b/TODO index 7fc881c8d..17785c848 100644 --- a/TODO +++ b/TODO @@ -120,6 +120,10 @@ :name nil :type nil) fails to handle the logical-pathname-ness of ASDFTEST. *** `#5(1 ,@`(2 3)))` returns #(1 2 3), rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3). +*** XCL recognizes :unspecific for a pathname type, + but prints the namestring with a dot separator! + (make-pathname :name "foo" :type :unspecific) ==> #P"foo." + If bug is ever fixed, upgrade *unspecific-pathname-type* in uiop/pathname. ** GCL is almost working again; but implementation bugs remain. See November 2013 discussion on gcl-devel. diff --git a/bundle.lisp b/bundle.lisp index a36fff7e1..71fe5c5fd 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -184,6 +184,7 @@ itself.")) ;; operation on a system and its dependencies (operation-original-initargs instance)))) (defmethod bundle-op-build-args :around ((o no-ld-flags-op)) + #+xcl (declare (ignorable o)) (let ((args (call-next-method))) (remf args :ld-flags) args)) @@ -418,9 +419,10 @@ itself.")) ;; operation on a system and its dependencies (perform-lisp-load-fasl o s)) (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) + #+xcl (declare (ignorable o)) `((load-op ,s) ,@(call-next-method)))) - #| ;; Example use: +#| ;; Example use: (asdf:defsystem :precompiled-asdf-utils :class asdf::precompiled-system :fasl (asdf:apply-output-translations (asdf:system-relative-pathname :asdf-utils "asdf-utils.system.fasl"))) (asdf:load-system :precompiled-asdf-utils) |# diff --git a/plan.lisp b/plan.lisp index eb972f647..2d84d6bb6 100644 --- a/plan.lisp +++ b/plan.lisp @@ -384,7 +384,6 @@ the action of OPERATION on COMPONENT in the PLAN")) (when (action-planned-p new-status) (push (cons o c) (plan-actions-r p))))) - ;;;; high-level interface: traverse, perform-plan, plan-operates-on-p (with-upgradability () (defgeneric make-plan (plan-class operation component &key &allow-other-keys) @@ -405,6 +404,7 @@ the action of OPERATION on COMPONENT in the PLAN")) plan)) (defmethod perform-plan :around ((plan t) &key) + #+xcl (declare (ignorable plan)) (let ((*package* *package*) (*readtable* *readtable*)) (with-compilation-unit () ;; backward-compatibility. diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index 05b44c48f..edb4ee5e3 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -91,8 +91,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; See CLHS make-pathname and 19.2.2.2.3. ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* - #+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl xcl) :unspecific - #+(or clisp ecl gcl #|These haven't been tested:|# cormanlisp mcl) nil + #+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl) :unspecific + #+(or clisp ecl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME") (defun make-pathname* (&rest keys &key (directory nil) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index fcd31f954..80051980e 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -557,6 +557,7 @@ THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as Upon exit of THUNK, the AFTER thunk if defined is CALL-FUNCTION'ed with the pathname as argument. If AFTER is defined, its results are returned, otherwise, the results of THUNK are returned. Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'ed returns true." + #+xcl (declare (ignorable typep)) (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (loop -- GitLab