Skip to content
Snippets Groups Projects
Commit 18e851e4 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau Committed by Robert P. Goldman
Browse files

XCL cleanups(!): Downgrade *unspecific-pathname-type* due to XCL bug. Hush compile warnings.

parent c2654806
No related branches found
No related tags found
No related merge requests found
...@@ -120,6 +120,10 @@ ...@@ -120,6 +120,10 @@
:name nil :type nil) fails to handle the logical-pathname-ness of ASDFTEST. :name nil :type nil) fails to handle the logical-pathname-ness of ASDFTEST.
*** `#5(1 ,@`(2 3)))` returns #(1 2 3), *** `#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). 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. ** GCL is almost working again; but implementation bugs remain.
See November 2013 discussion on gcl-devel. See November 2013 discussion on gcl-devel.
......
...@@ -184,6 +184,7 @@ itself.")) ;; operation on a system and its dependencies ...@@ -184,6 +184,7 @@ itself.")) ;; operation on a system and its dependencies
(operation-original-initargs instance)))) (operation-original-initargs instance))))
(defmethod bundle-op-build-args :around ((o no-ld-flags-op)) (defmethod bundle-op-build-args :around ((o no-ld-flags-op))
#+xcl (declare (ignorable o))
(let ((args (call-next-method))) (let ((args (call-next-method)))
(remf args :ld-flags) (remf args :ld-flags)
args)) args))
...@@ -418,9 +419,10 @@ itself.")) ;; operation on a system and its dependencies ...@@ -418,9 +419,10 @@ itself.")) ;; operation on a system and its dependencies
(perform-lisp-load-fasl o s)) (perform-lisp-load-fasl o s))
(defmethod component-depends-on ((o load-fasl-op) (s precompiled-system)) (defmethod component-depends-on ((o load-fasl-op) (s precompiled-system))
#+xcl (declare (ignorable o))
`((load-op ,s) ,@(call-next-method)))) `((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: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) (asdf:load-system :precompiled-asdf-utils)
|# |#
......
...@@ -384,7 +384,6 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -384,7 +384,6 @@ the action of OPERATION on COMPONENT in the PLAN"))
(when (action-planned-p new-status) (when (action-planned-p new-status)
(push (cons o c) (plan-actions-r p))))) (push (cons o c) (plan-actions-r p)))))
;;;; high-level interface: traverse, perform-plan, plan-operates-on-p ;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
(with-upgradability () (with-upgradability ()
(defgeneric make-plan (plan-class operation component &key &allow-other-keys) (defgeneric make-plan (plan-class operation component &key &allow-other-keys)
...@@ -405,6 +404,7 @@ the action of OPERATION on COMPONENT in the PLAN")) ...@@ -405,6 +404,7 @@ the action of OPERATION on COMPONENT in the PLAN"))
plan)) plan))
(defmethod perform-plan :around ((plan t) &key) (defmethod perform-plan :around ((plan t) &key)
#+xcl (declare (ignorable plan))
(let ((*package* *package*) (let ((*package* *package*)
(*readtable* *readtable*)) (*readtable* *readtable*))
(with-compilation-unit () ;; backward-compatibility. (with-compilation-unit () ;; backward-compatibility.
......
...@@ -91,8 +91,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ...@@ -91,8 +91,8 @@ by the underlying implementation's MAKE-PATHNAME and other primitives"
;; See CLHS make-pathname and 19.2.2.2.3. ;; See CLHS make-pathname and 19.2.2.2.3.
;; This will be :unspecific if supported, or NIL if not. ;; This will be :unspecific if supported, or NIL if not.
(defparameter *unspecific-pathname-type* (defparameter *unspecific-pathname-type*
#+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl xcl) :unspecific #+(or abcl allegro clozure cmu genera lispworks mkcl sbcl scl) :unspecific
#+(or clisp ecl gcl #|These haven't been tested:|# cormanlisp mcl) nil #+(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") "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")
(defun make-pathname* (&rest keys &key (directory nil) (defun make-pathname* (&rest keys &key (directory nil)
......
...@@ -557,6 +557,7 @@ THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as ...@@ -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. 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. 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." 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)) (check-type direction (member :output :io))
(assert (or want-stream-p want-pathname-p)) (assert (or want-stream-p want-pathname-p))
(loop (loop
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment