Skip to content
Snippets Groups Projects
Commit 8b6734db authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.720: integrate feedback from Clozure, Franz.

* minor stylistic cleanups for CCL
* refactor use of *load-truename* for more consistency.
parent bb90da28
No related branches found
Tags 1.720
No related merge requests found
...@@ -49,8 +49,8 @@ ...@@ -49,8 +49,8 @@
(cl:in-package :cl-user) (cl:in-package :cl-user)
(declaim (optimize (speed 2) (debug 2) (safety 3)) #|(declaim (optimize (speed 2) (debug 2) (safety 3))
#+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note)) #+sbcl (sb-ext:muffle-conditions sb-ext:compiler-note))|#
#+ecl (require :cmp) #+ecl (require :cmp)
...@@ -70,7 +70,7 @@ ...@@ -70,7 +70,7 @@
:test 'equalp :key 'car)) :test 'equalp :key 'car))
(let* ((asdf-version (let* ((asdf-version
;; the 1+ helps the version bumping script discriminate ;; the 1+ helps the version bumping script discriminate
(subseq "VERSION:1.719" (1+ (length "VERSION")))) (subseq "VERSION:1.720" (1+ (length "VERSION"))))
(existing-asdf (find-package :asdf)) (existing-asdf (find-package :asdf))
(vername '#:*asdf-version*) (vername '#:*asdf-version*)
(versym (and existing-asdf (versym (and existing-asdf
...@@ -626,7 +626,7 @@ pathnames." ...@@ -626,7 +626,7 @@ pathnames."
#+sbcl #+sbcl
(sb-ext:posix-getenv x) (sb-ext:posix-getenv x)
#+clozure #+clozure
(ccl::getenv x) (ccl:getenv x)
#+clisp #+clisp
(ext:getenv x) (ext:getenv x)
#+cmu #+cmu
...@@ -1947,24 +1947,21 @@ details." ...@@ -1947,24 +1947,21 @@ details."
;;;; ------------------------------------------------------------------------- ;;;; -------------------------------------------------------------------------
;;;; Defsystem ;;;; Defsystem
(defun load-pathname ()
(let ((pn (or *load-pathname* *compile-file-pathname*)))
(if *resolve-symlinks*
(and pn (resolve-symlinks pn))
pn)))
(defun determine-system-pathname (pathname pathname-supplied-p) (defun determine-system-pathname (pathname pathname-supplied-p)
;; called from the defsystem macro. ;; The defsystem macro calls us to determine
;; the pathname of a system is either ;; the pathname of a system as follows:
;; 1. the one supplied, ;; 1. the one supplied,
;; 2. derived from the *load-truename* (see below), or ;; 2. derived from *load-pathname* via load-pathname
;; 3. taken from *default-pathname-defaults* ;; 3. taken from the *default-pathname-defaults* via current-directory
;; (let* ((file-pathname (load-pathname))
;; if using *load-truename*, then we also deal with whether or not (directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
;; to resolve symbolic links. If not resolving symlinks, then we use (or (and pathname-supplied-p (merge-pathnames* pathname directory-pathname))
;; *load-pathname* instead of *load-truename* since in some
;; implementations, the latter has *already resolved it.
(let ((file-pathname
(when (or *load-pathname* *compile-file-pathname*)
(pathname-directory-pathname
(if *resolve-symlinks*
(resolve-symlinks (or *load-truename* *compile-file-truename*))
*load-pathname*)))))
(or (and pathname-supplied-p (merge-pathnames* pathname file-pathname))
file-pathname file-pathname
(current-directory)))) (current-directory))))
...@@ -1987,7 +1984,7 @@ details." ...@@ -1987,7 +1984,7 @@ details."
(t (t
(register-system (quote ,name) (register-system (quote ,name)
(make-instance ',class :name ',name)))) (make-instance ',class :name ',name))))
(%set-system-source-file *load-truename* (%set-system-source-file (load-pathname)
(cdr (system-registered-p ',name)))) (cdr (system-registered-p ',name))))
(parse-component-form (parse-component-form
nil (list* nil (list*
...@@ -2563,6 +2560,7 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2563,6 +2560,7 @@ with a different configuration, so the configuration would be re-read then."
(relativize-pathname-directory (current-directory))) (relativize-pathname-directory (current-directory)))
((eql :implementation) (implementation-identifier)) ((eql :implementation) (implementation-identifier))
((eql :implementation-type) (string-downcase (implementation-type))) ((eql :implementation-type) (string-downcase (implementation-type)))
#-(and (or win32 windows mswindows mingw32) (not cygwin))
((eql :uid) (princ-to-string (get-uid))))) ((eql :uid) (princ-to-string (get-uid)))))
(d (if (pathnamep x) r (ensure-directory-pathname r))) (d (if (pathnamep x) r (ensure-directory-pathname r)))
(s (if (and wildenp (not (pathnamep x))) (s (if (and wildenp (not (pathnamep x)))
...@@ -2677,8 +2675,8 @@ with a different configuration, so the configuration would be re-read then." ...@@ -2677,8 +2675,8 @@ with a different configuration, so the configuration would be re-read then."
;; Some implementations have precompiled ASDF systems, ;; Some implementations have precompiled ASDF systems,
;; so we must disable translations for implementation paths. ;; so we must disable translations for implementation paths.
#+sbcl (,(getenv "SBCL_HOME") ()) #+sbcl (,(getenv "SBCL_HOME") ())
#+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; only needed if LPNs are resolved manually. #+ecl (,(translate-logical-pathname "SYS:**;*.*") ()) ; not needed: no precompiled ASDF system
#+clozure (,(wilden (ccl::ccl-directory)) ()) ; not needed: no precompiled ASDF system #+clozure (,(wilden (truename #p"ccl:")) ()) ; not needed: no precompiled ASDF system
;; All-import, here is where we want user stuff to be: ;; All-import, here is where we want user stuff to be:
:inherit-configuration :inherit-configuration
;; These are for convenience, and can be overridden by the user: ;; These are for convenience, and can be overridden by the user:
...@@ -3283,7 +3281,7 @@ with a different configuration, so the configuration would be re-read then." ...@@ -3283,7 +3281,7 @@ with a different configuration, so the configuration would be re-read then."
t)))) t))))
(pushnew 'module-provide-asdf (pushnew 'module-provide-asdf
#+abcl sys::*module-provider-functions* #+abcl sys::*module-provider-functions*
#+clozure ccl::*module-provider-functions* #+clozure ccl:*module-provider-functions*
#+cmu ext:*module-provider-functions* #+cmu ext:*module-provider-functions*
#+ecl si:*module-provider-functions* #+ecl si:*module-provider-functions*
#+sbcl sb-ext:*module-provider-functions*)) #+sbcl sb-ext:*module-provider-functions*))
......
...@@ -2635,11 +2635,12 @@ Windows support was notably quirky because of such non-portability. ...@@ -2635,11 +2635,12 @@ Windows support was notably quirky because of such non-portability.
@item @item
The internal test suite used to massively fail on many implementations. The internal test suite used to massively fail on many implementations.
While still incomplete, it now fully passes While still incomplete, it now fully passes
on all implementations supported by the test suite. on all implementations supported by the test suite,
except for GCL (due to GCL bugs).
@item @item
Support was lacking for some implementations. Support was lacking for some implementations.
ABCL was notably wholly broken. ABCL and GCL were notably wholly broken.
ECL extensions were not integrated in the ASDF release. ECL extensions were not integrated in the ASDF release.
@item @item
...@@ -3089,12 +3090,8 @@ What would be a nice interface for this functionality? ...@@ -3089,12 +3090,8 @@ What would be a nice interface for this functionality?
@section Missing bits in implementation @section Missing bits in implementation
** all of the above
** reuse the same scratch package whenever a system is reloaded from disk ** reuse the same scratch package whenever a system is reloaded from disk
** rules for system pathname defaulting are not yet implemented properly
** proclamations probably aren't ** proclamations probably aren't
** when a system is reloaded with fewer components than it previously had, odd things happen ** when a system is reloaded with fewer components than it previously had, odd things happen
...@@ -3103,16 +3100,6 @@ We should do something inventive when processing a @code{defsystem} form, ...@@ -3103,16 +3100,6 @@ We should do something inventive when processing a @code{defsystem} form,
like take the list of kids and @code{setf} the slot to @code{nil}, like take the list of kids and @code{setf} the slot to @code{nil},
then transfer children from old to new list as they're found. then transfer children from old to new list as they're found.
** traverse may become a normal function
If you're defining methods on @code{traverse}, speak up.
** a lot of load-op methods can be rewritten to use input-files
so should be.
** (stuff that might happen later) ** (stuff that might happen later)
*** Propagation of the @code{:force} option. *** Propagation of the @code{:force} option.
......
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