Commit aa5cba5d authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.26.100: checkpointing a lot of progress.

* Pathname support has been cleaned up, yet again,
 extending and renaming COERCE-PATHNAME into PARSE-UNIX-NAMESTRING,
 also ENSURE-PATHNAME, many docstrings, and plenty of small enhancements.
* Bundles were refactored to take advantage of the new, more sensible,
 component-depends-on semantics.
* Image support was cleaned up again, and program-op was implemented
 to produce a standalone executable on supported platforms;
 a working hello-world-example is included amongst tests.
* The *compile-file-function* indirection was removed, with the
 ECL and MKCL object file support
 being folded into compile-file* instead.
* systems now can have NIL as component-pathname,
 instead of providing a non-sensible bogus pathname
 when no sensible pathname was determined.
 Most of our pathname functions have sensible default behavior
 when provided NIL instead of a pathname as an argument.
parent 0af76dd1
......@@ -37,6 +37,7 @@ tmp/
......@@ -4,17 +4,24 @@ webhome_public := ""
clnet_home := "/project/asdf/public_html/"
sourceDirectory := $(shell pwd)
#### Common Lisp implementations available for testing.
## export ASDF_TEST_LISPS to override the default list of such implementations,
## or specify a lisps= argument at the make command-line
lisps ?= ${ASDF_TEST_LISPS}
lisps ?= ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks allegromodern xcl gcl
## cormancl genera lispworks-personal-edition mkcl rmcl
## Some are manually tested once in a while.
## MAJOR FAIL: gclcvs -- Compiler bug fixed upstream, but gcl fails to compile on modern Linuxen.
## grep for #+/#- features in the test/ directory to see plenty of disabled tests.
## Make sure testing remains within the confines of this filesystem tree
export ASDF_OUTPUT_TRANSLATIONS := (:output-translations (t ("${sourceDirectory}/build/fasls" :implementation)) :ignore-inherited-configuration)
export CL_SOURCE_REGISTRY := (:source-registry (:tree "${sourceDirectory}") :ignore-inherited-configuration)
## MAJOR FAIL: gclcvs -- COMPILER BUG! Upstream fixed it, but upstream fails to compile.
## NOT SUPPORTED BY OUR TESTS: cormancl genera lispworks-personal-edition mkcl rmcl. Manually tested once in a while.
lisp ?= sbcl
......@@ -37,10 +44,15 @@ XCL ?= xcl
driver_lisp := header.lisp package.lisp compatibility.lisp utility.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp driver.lisp
asdf_lisp := upgrade.lisp component.lisp system.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp
# Making ASDF itself should be our first, default, target:
build/asdf.lisp: $(wildcard *.lisp)
mkdir -p build
cat $(driver_lisp) $(asdf_lisp) > $@
# This quickly locates such mistakes as unbalanced parentheses:
rlwrap sbcl `for i in $(driver_lisp) $(asdf_lisp) ; do echo --load $$i ; done`
install: archive-copy
......@@ -56,18 +68,13 @@ archive-copy: archive build/asdf.lisp
${MAKE} push
git checkout master
### Count lines separately for asdf-driver and asdf itself:
@wc $(driver_lisp) | sort -n ; echo ; \
wc $(asdf_lisp) | sort -n ; \
echo ; \
wc $(driver_lisp) $(asdf_lisp) | tail -n 1
wc $(driver_lisp)
wc $(asdf_lisp)
git status
git push --tags release master
......@@ -136,12 +143,12 @@ debian-package: mrproper
: $${RELEASE:="$$(git tag -l '2.[0-9][0-9]' | tail -n 1)"} ; \
git-buildpackage --git-debian-branch=release --git-upstream-branch=$$RELEASE --git-tag --git-retag --git-ignore-branch
# Replace SBCL's ASDF with the current one. -- Not recommended now that SBCL has ASDF2.
# Replace SBCL's ASDF with the current one. -- NOT recommended now that SBCL has ASDF2.
# for casual users, just use (asdf:load-system :asdf)
replace-sbcl-asdf: build/asdf.lisp
${SBCL} --eval '(compile-file "$<" :output-file (format nil "~Aasdf/asdf.fasl" (sb-int:sbcl-homedir-pathname)))' --eval '(quit)'
# Replace CCL's ASDF with the current one. -- Not recommended now that CCL has ASDF2.
# Replace CCL's ASDF with the current one. -- NOT recommended now that CCL has ASDF2.
# for casual users, just use (asdf:load-system :asdf)
replace-ccl-asdf: build/asdf.lisp
${CCL} --eval '(progn(compile-file "$<" :output-file (compile-file-pathname (format nil "~Atools/asdf.lisp" (ccl::ccl-directory))))(quit))'
......@@ -150,6 +157,7 @@ WRONGFUL_TAGS := 1.37 1.1720 README RELEASE STABLE
# Delete wrongful tags from local repository
for i in ${WRONGFUL_TAGS} ; do git tag -d $$i ; done
git tag 1.37 c7738c62 # restore the *correct* 1.37 tag.
# Delete wrongful tags from remote repository
......@@ -112,10 +112,17 @@ You can put together sentences using this phrase."))
"Translate output files, unless asked not to"
operation component ;; hush genera, not convinced by declare ignorable(!)
(multiple-value-bind (files fixedp) (call-next-method)
(multiple-value-bind (pathnames fixedp) (call-next-method)
;; 1- Make sure we have absolute pathnames
(let* ((directory (pathname-directory-pathname (component-pathname component)))
(loop :for pathname :in pathnames
:collect (ensure-pathname
(subpathname directory pathname) :want-absolute t))))
;; 2- Translate those pathnames as required
(if fixedp
(mapcar *output-translation-function* files)))
(mapcar *output-translation-function* absolute-pathnames))))
(defmethod output-files ((o operation) (c component))
(declare (ignorable o c))
;;; -*- mode: lisp -*-
(defpackage :asdf-driver-system (:use :cl :asdf))
(defun call-without-redefinition-warnings (thunk)
(handler-bind (#+clozure (ccl:compiler-warning #'muffle-warning))
(funcall thunk)))
(defsystem :asdf-driver
:licence "MIT"
......@@ -6,6 +11,8 @@
:long-description "Basic general-purpose utilities that is in such a need
that you can't portably construct a complete program without using them."
#+asdf2.27 :version #+asdf2.27 (:read-file-form "version.lisp-expr")
:defsystem-depends-on (#+(and (not asdf2.27) (or clisp xcl)) :asdf)
:around-compile call-without-redefinition-warnings
((:file "header")
(:file "package")
......@@ -15,7 +15,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.26.99" ;; to be automatically updated by bin/bump-revision
:version "2.26.100" ;; to be automatically updated by bin/bump-revision
:depends-on ()
:components ((:module "build" :components ((:file "asdf"))))
:in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op generate-asdf))))
......@@ -10,7 +10,6 @@
......@@ -22,11 +21,12 @@
;; Old deprecated name for the same thing. Please update your software.
(component-sibling-dependencies component))
(defun* merge-component-name-type (name &key type defaults)
;; For backward-compatibility only, for people using internals.
;; Will be removed in a future release, e.g. 2.016.
(coerce-pathname name :type type :defaults defaults))
(defun* coerce-pathname (name &key type defaults)
;; For backward-compatibility only, for people using internals
;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb
;; Will be removed in a future release, e.g. 2.30.
(parse-unix-namestring name :type type :defaults defaults))
(defgeneric* operation-forced (operation)) ;; Used by swank.asd for swank-loader.
(defmethod operation-forced ((o operation)) (getf (operation-original-initargs o) :force))
......@@ -71,7 +71,7 @@ if that's whay you mean." ;;)
#+(or clisp ecl mkcl)
(when (null map-all-source-files)
(error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on CLISP, ECL and MKCL"))
(let* ((fasl-type (fasl-type))
(let* ((fasl-type (compile-file-type))
(mapped-files (if map-all-source-files *wild-file*
(make-pathname :type fasl-type :defaults *wild-file*)))
This diff is collapsed.
......@@ -138,10 +138,11 @@ another pathname in a degenerate way."))
(defmethod component-relative-pathname ((component component))
(or (and (slot-boundp component 'relative-pathname)
(slot-value component 'relative-pathname))
(component-name component))
:want-relative t
:type (source-file-type component (component-system component)) ;; backward-compatibility
:defaults (component-parent-pathname component)))
......@@ -17,76 +17,59 @@
#:translate-output-p #:concatenated-source-file))
(in-package :asdf/concatenate-source)
;;; Concatenate sources
(defclass concatenate-source-op (operation) ())
(defclass load-concatenated-source-op (basic-load-op operation) ())
(defclass compile-concatenated-source-op (basic-compile-op operation) ())
(defclass load-compiled-concatenated-source-op (basic-load-op operation) ())
(defclass concatenate-source-op (bundle-op)
((bundle-type :initform "lisp")))
(defclass load-concatenated-source-op (basic-load-op operation)
((bundle-type :initform :no-output-file)))
(defclass compile-concatenated-source-op (basic-compile-op bundle-op)
((bundle-type :initform :fasl)))
(defclass load-compiled-concatenated-source-op (basic-load-op operation)
((bundle-type :initform :no-output-file)))
(defclass monolithic-concatenate-source-op (concatenate-source-op monolithic-op) ())
(defclass monolithic-load-concatenated-source-op (load-concatenated-source-op monolithic-op) ())
(defclass monolithic-compile-concatenated-source-op (compile-concatenated-source-op monolithic-op) ())
(defclass monolithic-load-compiled-concatenated-source-op (load-compiled-concatenated-source-op monolithic-op) ())
(defclass concatenated-source-system (system)
:initform nil :initarg :concatenated-source-file :reader system-concatenated-source-file)
:initform t :initarg :translate-output-p :reader system-translate-output-p)))
(defmethod system-concatenated-source-file ((s system))
(declare (ignorable s))
(defmethod system-translate-output-p ((s system))
(declare (ignorable s))
(defclass concatenated-source-system (bundle-system)
((bundle-pathname :initarg :concatenated-source-file)
(bundle-operation :initform :load-compiled-concatenated-source-op)))
(defmethod input-files ((o concatenate-source-op) (s system))
(loop :with op = (make-operation 'compile-op)
:with components = (gather-components op s
:include-self nil
:filter-type 'source-file
:other-systems (operation-monolithic-p o))
:with non-cl-source-files = nil
:with encoding = (or (component-encoding s) *default-encoding*)
(defmethod input-files ((operation concatenate-source-op) (s system))
(loop :with encoding = (or (component-encoding s) *default-encoding*)
:with other-encodings = '()
:with around-compile = (around-compile-hook s)
:with other-around-compile = '()
:for (o . c) :in components
:do (cond
((typep c 'cl-source-file)
:for c :in (gather-components s
:goal-operation 'compile-op
:keep-operation 'compile-op
:component-type 'component
:other-systems (operation-monolithic-p operation))
(when (typep c 'cl-source-file)
(let ((e (component-encoding c)))
(unless (equal e encoding)
(pushnew e other-encodings :test 'equal)))
(let ((a (around-compile-hook c)))
(unless (equal a around-compile)
(pushnew a other-around-compile :test 'equal))))
(push c non-cl-source-files)))
:append (input-files o c) :into inputs
(pushnew a other-around-compile :test 'equal)))
(input-files (make-operation 'compile-op) c)) :into inputs
(when non-cl-source-files
(warn "~S depends on these non CL source files: ~A"
'concatenated-source-op non-cl-source-files))
(when other-encodings
(warn "~S uses encoding ~A but has sources that use these encodings: ~A"
'concatenated-source-op encoding other-encodings))
operation encoding other-encodings))
(when other-around-compile
(warn "~S uses around-compile hook ~A but has sources that use these hooks: ~A"
'concatenated-source-op around-compile other-around-compile))
operation around-compile other-around-compile))
(return inputs)))
(defmethod output-files ((o concatenate-source-op) (s system))
(declare (ignorable o))
(let ((of (or (system-concatenated-source-file s) (strcat (coerce-name s) ".lisp")))
(top (system-translate-output-p s)))
(values (list (system-relative-pathname s of)) (not top))))
(defmethod input-files ((o load-concatenated-source-op) (s system))
(output-files (find-operation o 'concatenate-source-op) s))
(defmethod input-files ((o compile-concatenated-source-op) (s system))
......@@ -97,6 +80,16 @@
(defmethod input-files ((o load-compiled-concatenated-source-op) (s system))
(output-files (find-operation o 'compile-concatenated-source-op) s))
(defmethod input-files ((o monolithic-load-concatenated-source-op) (s system))
(output-files (find-operation o 'monolithic-concatenate-source-op) s))
(defmethod input-files ((o monolithic-compile-concatenated-source-op) (s system))
(output-files (find-operation o 'monolithic-concatenate-source-op) s))
(defmethod output-files ((o monolithic-compile-concatenated-source-op) (s system))
(let ((input (first (input-files o s))))
(list (compile-file-pathname input))))
(defmethod input-files ((o monolithic-load-compiled-concatenated-source-op) (s system))
(output-files (find-operation o 'monolithic-compile-concatenated-source-op) s))
(defmethod perform ((o concatenate-source-op) (s system))
(let ((inputs (input-files o s))
(output (output-file o s)))
......@@ -132,7 +132,7 @@ be applied to the results to yield a configuration form. Current
values of TAG include :source-registry and :output-translations."
(let ((files (sort (ignore-errors
(directory* (make-pathname :name *wild* :type "conf" :defaults directory))))
#'string< :key #'namestring)))
......@@ -151,45 +151,47 @@ values of TAG include :source-registry and :output-translations."
:do (report-invalid-form invalid-form-reporter :form form :location file)))
(declaim (ftype (function (t &key (:directory boolean) (:wilden boolean))
(values (or null pathname) &optional))
(defun* resolve-relative-location-component (x &key directory wilden)
(let ((r (etypecase x
(defun* resolve-relative-location-component (x &key want-directory wilden)
(let* ((r (etypecase x
(pathname x)
(string (coerce-pathname x :type (when directory :directory)))
(string (parse-unix-namestring
x :want-directory want-directory))
(if (null (cdr x))
(car x) :directory directory :wilden wilden)
(car x) :want-directory want-directory :wilden wilden)
(let* ((car (resolve-relative-location-component
(car x) :directory t :wilden nil)))
(car x) :want-directory t :wilden nil)))
(cdr x) :directory directory :wilden wilden)
(cdr x) :want-directory want-directory :wilden wilden)
((eql :default-directory) (nil-pathname)) ;; OBSOLETE
((eql :*/) *wild-directory*)
((eql :**/) *wild-inferiors*)
((eql :*.*.*) *wild-file*)
((eql :implementation)
(coerce-pathname (implementation-identifier) :type :directory))
(implementation-identifier) :want-directory t))
((eql :implementation-type)
(coerce-pathname (string-downcase (implementation-type)) :type :directory))
(string-downcase (implementation-type)) :want-directory t))
((eql :hostname)
(coerce-pathname (hostname) :type :directory)))))
(when (absolute-pathname-p r)
(error (compatfmt "~@<pathname ~S is not relative~@:>") x))
(if (or (pathnamep x) (member x '(:*/ :**/ :*.*.*)) (not wilden))
r (wilden r))))
(parse-unix-namestring (hostname) :want-directory t))))
(w (if (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*))))
(wilden r)
(ensure-pathname w :want-relative t)))
(defvar *here-directory* nil
"This special variable is bound to the currect directory during calls to
PROCESS-SOURCE-REGISTRY in order that we be able to interpret the :here
(defvar *user-cache*
(defvar *user-cache* nil
"A specification as per RESOLVE-LOCATION of where the user keeps his FASL cache")
(defun compute-user-cache ()
(setf *user-cache*
(flet ((try (x &rest sub) (and x `(,x ,@sub))))
(try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation)
......@@ -197,72 +199,66 @@ directive.")
(try (or (get-folder-path :local-appdata)
(get-folder-path :appdata))
"common-lisp" "cache" :implementation))
'(:home ".cache" "common-lisp" :implementation))))
'(:home ".cache" "common-lisp" :implementation)))))
(register-image-restore-hook 'compute-user-cache)
(defun* resolve-absolute-location-component (x &key directory wilden)
(let* ((r
(etypecase x
(defun* resolve-absolute-location-component (x &key want-directory wilden)
(let* ((r (etypecase x
(pathname x)
(string (let ((p (#+mcl probe-posix #-mcl parse-namestring x)))
(let ((p #-mcl (parse-namestring x)
#+mcl (probe-posix x)))
#+mcl (unless p (error "POSIX pathname ~S does not exist" x))
(if directory (ensure-directory-pathname p) p)))
(if want-directory (ensure-directory-pathname p) p)))
(return-from resolve-absolute-location-component
(if (null (cdr x))
(car x) :directory directory :wilden wilden)
(car x) :want-directory want-directory :wilden wilden)
(cdr x) :directory directory :wilden wilden)
(cdr x) :want-directory want-directory :wilden wilden)
(car x) :directory t :wilden nil)))))
(car x) :want-directory t :wilden nil)))))
((eql :root)
;; special magic! we encode such paths as relative pathnames,
;; but it means "relative to the root of the source pathname's host and device".
;; special magic! we return a relative pathname,
;; but what it means to the output-translations is
;; "relative to the root of the source pathname's host and device".
(return-from resolve-absolute-location-component
(let ((p (make-pathname* :directory '(:relative))))
(if wilden (wilden p) p))))
((eql :home) (user-homedir))
((eql :here)
(resolve-location (or *here-directory*
;; give semantics in the case of use interactively
:directory t :wilden nil))
((eql :user-cache) (resolve-location *user-cache* :directory t :wilden nil))
((eql :system-cache)
(error "Using the :system-cache is deprecated. ~%~
Please remove it from your ASDF configuration"))
((eql :default-directory) (default-directory))))
(s (if (and wilden (not (or (pathnamep x))))
((eql :here) (resolve-absolute-location-component
*here-directory* :want-directory t :wilden nil))
((eql :user-cache) (resolve-absolute-location-component
*user-cache* :want-directory t :wilden nil))))
(w (if (and wilden (not (pathnamep x)))
(wilden r)
(unless (absolute-pathname-p s)
(error (compatfmt "~@<Invalid designator for an absolute pathname: ~3i~_~S~@:>") x))
(ensure-pathname w :want-absolute t)))
(defun* resolve-location (x &key directory wilden)
(defun* resolve-location (x &key want-directory wilden)
(if (atom x)
(resolve-absolute-location-component x :directory directory :wilden wilden)
(resolve-absolute-location-component x :want-directory want-directory :wilden wilden)
(loop :with path = (resolve-absolute-location-component
(car x) :directory (and (or directory (cdr x)) t)
(car x) :want-directory (and (or want-directory (cdr x)) t)
:wilden (and wilden (null (cdr x))))
:for (component . morep) :on (cdr x)
:for dir = (and (or morep directory) t)
:for dir = (and (or morep want-directory) t)
:for wild = (and wilden (not morep))
:do (setf path (merge-pathnames*
component :directory dir :wilden wild)
component :want-directory dir :wilden wild)
:finally (return path))))
(defun* location-designator-p (x)
(flet ((absolute-component-p (c)
(typep c '(or string pathname
(member :root :home :here :user-cache :system-cache :default-directory))))
(member :root :home :here :user-cache))))
(relative-component-p (c)
(typep c '(or string pathname
(member :default-directory :*/ :**/ :*.*.*
:implementation :implementation-type)))))
(member :*/ :**/ :*.*.* :implementation :implementation-type)))))
(or (typep x 'boolean)
(absolute-component-p x)
(and (consp x) (absolute-component-p (first x)) (every #'relative-component-p (rest x))))))
......@@ -91,32 +91,55 @@ cl-asdf (2:2.27-1) unstable; urgency=low
to manage the same effects while making every effort to
Do The Right Thing(tm) in case of hot upgrade.
* ASDF-DRIVER is a separately-usable library for Common Lisp runtime support.
It is transcluded in asdf.lisp (i.e. when delivering ASDF as a separate
bootstrap file, the contents of ASDF-DRIVER have been included in it),
but can also be used as a separate ASDF system on top of an old ASDF
(within limits: CLISP and XCL still need a recent ASDF).
The package ASDF/DRIVER (with short nickname :D) re-exports
all the functions that ASDF needed to run portably.
* Pathnames are a notable part of ASDF-DRIVER, required to deal
portably with pathnames despite the many bugs and variations
from platform to platform. See notably in pathname.lisp,
* Image lifecycle support is included in ASDF-DRIVER (and thus ASDF);
this standardizes things like access to *COMMAND-LINE-ARGUMENTS*,
declaring an entry-point to a program, hook functions and/or a prelude
to run before to start the main entry, and a postlude and/or hook functions
to run before to dump an image, dumping or creating an image, etc.
ASDF provides initial implementations of an operation program-op
to create standalone executables (if available on your implementation).
* Internals have been refactored, and some sorry features were excised.
The semantics of OPERATION-DONE-P is simplified and now well-specified.
FIND-COMPONENT will pass component objects through, and
a corresponding FIND-OPERATION replaces MAKE-SUB-OPERATION.
Several internal accessors were renamed.
Many internal accessors were renamed, after checking on Quicklisp
that no one was using them.
* Portability updates were done for
ABCL, CLISP, CMUCL, ECL, LispWorks Personal Edition, MKCL, XCL.
ABCL, CLISP, Clozure CL, CMUCL, ECL, LispWorks Personal Edition, MKCL, XCL.
Working support for GCL 2.6 was restored, with notable limitations
including lack of support for output-translations or logical-pathnames.
* Documentation received some small updates.
* Tests were updated, notably including support for asdf-bundle.
* Tests were updated, notably including support for bundles and encodings.
They were successfully run on ccl clisp sbcl ecl ecl_bytecodes
cmucl abcl scl allegro lispworks allegromodern xcl.
Manual tests were run on lispworks-personal-edition genera.
Untested were cormancl mkcl rmcl.
* POIU was updated. This extension is distributed separately from ASDF.
It is now much simplified and made more correct by construction by
* POIU was updated. This extension is still distributed separately from ASDF.
It is now much simplified and made correct by construction by
reusing the new TRAVERSE infrastructure of ASDF and now being able to
assume the ASDF object model is a complete description of dependencies.
On SBCL it will handle deferred warnings from background compilations.
On platforms that cannot fork it will gracefully fall back
to serial compilation.
Where forking is not possible or not supported,
it will gracefully fall back to serial compilation.
* SLIME support for ASDF was significantly enhanced.
It is distributed separately from ASDF, with SLIME.
......@@ -9,25 +9,32 @@
#+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of)
#:defsystem #:*default-component-class*
#:class-for-type #:do-defsystem
#:determine-system-pathname #:parse-component-form
#:defsystem #:register-system-definition
#:class-for-type #:*default-component-class*
#:determine-system-directory #:parse-component-form
#:duplicate-names #:sysdef-error-component #:check-component-input))
(in-package :asdf/defsystem)
;;; Pathname
(defun* determine-system-pathname (pathname)
;; The defsystem macro calls us to determine
(defun* determine-system-directory (pathname)
;; The defsystem macro calls this function to determine
;; the pathname of a system as follows:
;; 1. the one supplied,
;; 2. derived from *load-pathname* via load-pathname
;; 3. taken from the *default-pathname-defaults* via default-directory
(let* ((file-pathname (load-pathname))
(directory-pathname (and file-pathname (pathname-directory-pathname file-pathname))))
(or (and pathname (subpathname directory-pathname pathname :type :directory))
;; 1. if the pathname argument is an pathname object (NOT a namestring),
;; that is already an absolute pathname, return it.
;; 2. otherwise, the directory containing the CURRENT-LISP-FILE-PATHNAME
;; is considered (as deduced from e.g. *LOAD-PATHNAME*), and
;; if it is indeed available and an absolute pathname, then
;; the PATHNAME argument is normalized to a relative pathname
;; and merged into that DIRECTORY as per SUBPATHNAME.
;; If no absolute pathname was found, we return NIL.
(check-type pathname (or null string pathname))
(or (and (pathnamep pathname) (absolute-pathname-p pathname))
(let* ((lisp-file-pathname (resolve-symlinks* (current-lisp-file-pathname))))
(when (absolute-pathname-p lisp-file-pathname)
(subpathname lisp-file-pathname pathname :type :directory)))))
;;; Component class
......@@ -149,8 +156,8 @@
(when if-component-dep-fails (%resolve-if-component-dep-fails if-component-dep-fails ret))
(defun* do-defsystem (name &rest options
&key pathname (class 'system)
(defun* register-system-definition
(name &rest options &key pathname (class 'system) (source-file () sfp)
defsystem-depends-on &allow-other-keys)
;; The system must be registered before we parse the body,
;; otherwise we recur when trying to find an existing system
......@@ -160,17 +167,17 @@