jyknight will be happy. Passes test, when still resolving.
header_lisp := header.lisp
driver_lisp := package.lisp compatibility.lisp utility.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.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
+defsystem_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 $(header_lisp) $(driver_lisp) $(asdf_lisp) > $@
+ cat $(header_lisp) $(driver_lisp) $(defsystem_lisp) > $@
# This quickly locates such mistakes as unbalanced parentheses:
load: build/asdf.lisp
rlwrap sbcl \
- `for i in $(driver_lisp) $(asdf_lisp) ; do echo --load $$i ; done` \
+ `for i in $(driver_lisp) $(defsystem_lisp) ; do echo --load $$i ; done` \
--eval '(in-package :asdf)'
install: archive-copy
driver-files:
@echo $(driver_lisp)
+defsystem-files:
+ @echo $(defsystem_lisp)
+
archive: build/asdf.lisp
#${SBCL} --userinit /dev/null --sysinit /dev/null --load bin/make-helper.lisp \
# --eval "(rewrite-license)" --eval "(quit)"
- ./bin/asdf-builder make-tarballs
+ ./bin/asdf-builder make-and-publish-archive
archive-copy: archive build/asdf.lisp
git checkout release
### Count lines separately for asdf-driver and asdf itself:
wc:
@wc $(driver_lisp) | sort -n ; echo ; \
- wc $(header_lisp) $(asdf_lisp) | sort -n ; \
+ wc $(header_lisp) $(defsystem_lisp) | sort -n ; \
echo ; \
- wc $(driver_lisp) $(asdf_lisp) | tail -n 1
+ wc $(header_lisp) $(driver_lisp) $(defsystem_lisp) | tail -n 1
push:
git status
;; 1- Make sure we have absolute pathnames
(let* ((directory (pathname-directory-pathname (component-pathname component)))
(absolute-pathnames
- (loop :for pathname :in pathnames
- :collect (ensure-pathname
- (subpathname directory pathname) :want-absolute t))))
+ (loop
+ :for pathname :in pathnames
+ :collect (ensure-pathname-absolute pathname directory))))
;; 2- Translate those pathnames as required
(if fixedp
absolute-pathnames
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
- :version "2.26.118" ;; to be automatically updated by bin/bump-revision
+ :version "2.26.119" ;; 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))))
(defvar *asdf-dir*
(ensure-pathname (system-relative-pathname :asdf ())
:want-physical t :want-absolute t
- :want-existing t :ensure-truename t))
+ :want-existing t :truename t))
(defparameter /asdf-dir/
(native-namestring *asdf-dir*))
(defun apath (x &rest keys) (apply 'subpathname *asdf-dir* x keys))
:ensure-subpath t))
(defparameter /build-dir/
(native-namestring *build-dir*))
+(defun bpath (x &rest keys) (apply 'subpathname *build-dir* x keys))
(defparameter *version*
(safe-read-file-form
(defun tarname (name) (strcat name ".tar.gz"))
-(defun run-program* (x)
- (format t "~A~%" x)
- (run-program/ x)
- (values))
-
(defun make-tarball-under-build (name base files)
(check-type name string)
(ensure-pathname base :want-absolute t :want-existing t :want-directory t)
(ensure-pathname
base
:want-absolute t :want-directory t
- :want-existing t :ensure-truename t)))
+ :want-existing t :truename t)))
(destination
(ensure-pathname
name
(error "Destination ~S already exists, not taking chances - you can delete it yourself."
destination))
(ensure-directories-exist destination)
- (run-program* (format nil "cd ~S && cp -lax --parents ~{~S ~} ~S"
- /base/ /files/ /destination/))
- (run-program* (format nil "tar zcfC ~S ~S ~S/"
- /tarball/ /build-dir/ name))
- (run-program* `("rm" "-rf" ,/destination/)))
- (values))
+ (run (format nil "cd ~S && cp -lax --parents ~{~S ~} ~S"
+ /base/ /files/ /destination/) :show t)
+ (run (format nil "tar zcfC ~S ~S ~S/"
+ /tarball/ /build-dir/ name) :show t)
+ (run `("rm" "-rf" ,/destination/) :show t)
+ (values)))
(defun driver-files ()
(list* "asdf-driver.asd" "version.lisp-expr"
(list* "asdf.asd" "build/asdf.lisp" "version.lisp-expr" "header.lisp"
(system-source-files :asdf/defsystem)))
(defun asdf-defsystem-name ()
- (format nil "asdf-system-~A" *version*))
+ (format nil "asdf-defsystem-~A" *version*))
(defun make-asdf-defsystem-tarball ()
(build-asdf)
(make-tarball-under-build (asdf-defsystem-name) *asdf-dir* (asdf-defsystem-files)))
(format nil "asdf-~A" *version*))
(defun make-git-tarball ()
(build-asdf)
- (run-program* (format nil "cd ~S && tar zcf build/~A.tar.gz build/asdf.lisp $(git ls-files)"
- /asdf-dir/ (asdf-git-name)))
+ (run (format nil "cd ~S && tar zcf build/~A.tar.gz build/asdf.lisp $(git ls-files)"
+ /asdf-dir/ (asdf-git-name)) :show t)
(values))
-(defun make-tarballs ()
+(defun asdf-lisp-name ()
+ (format nil "asdf-~A.lisp" *version*))
+
+(defun make-asdf-lisp ()
+ (build-asdf)
+ (concatenate-files (list (apath "build/asdf.lisp"))
+ (bpath (asdf-lisp-name))))
+
+(defun make-archive ()
(make-driver-tarball)
- (make-asdf-system-tarball)
+ (make-asdf-defsystem-tarball)
(make-git-tarball)
+ (make-asdf-lisp)
(values))
-(defun publish-tarballs ()
+(defvar *clnet* "clnet")
+(defvar *clnet-asdf-public* "/project/asdf/public_html/")
+
+(defun publish-archive ()
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
- (run-program* (format nil "cd ~S && rsync ~{~S ~}clnet:/project/asdf/public_html/archives/"
- /build-dir/ tarballs)))
+ (run (format nil "cd ~S && rsync ~{~S ~}~S clnet:/project/asdf/public_html/archives/"
+ /build-dir/ tarballs (asdf-lisp-name)) :show t))
(format t "~&To download the tarballs, point your browser at:~%
http://common-lisp.net/project/asdf/archives/
~%")
(values))
-(defun make-and-publish-tarballs ()
- (make-tarballs)
- (publish-tarballs))
+(defun link-archive ()
+ (run `(ln -sf ,(tarname (driver-name))
+ (,*clnet-asdf-public* "archives/asdf-driver.tar.gz"))
+ :show t :host *clnet*)
+ (values))
+
+(defun make-and-publish-archive ()
+ (make-archive)
+ (publish-archive)
+ (link-archive))
(defparameter *versioned-files*
'(("version.lisp-expr" "\"" "\"")
(build-asdf)))
(defun git-version ()
- (first (run-program/ '("git" "describe" "--tags" "--match" "[0-9].[0-9][0-9]") :output :lines)))
+ (first (run '("git" "describe" "--tags" "--match" "[0-9].[0-9][0-9]") :output :lines
+ :show t)))
;;;; Main entry point
(files (and system (output-files operation system))))
(if (or move-here (and (null move-here-p)
(member operation-name '(:program :binary))))
- (loop :with dest-path = (truename* (ensure-directories-exist move-here-path))
+ (loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path))
:for f :in files
:for new-f = (make-pathname :name (pathname-name f)
:type (pathname-type f)
;; and may be from within the EVAL-WHEN of a file compilation.
;; If no absolute pathname was found, we return NIL.
(check-type pathname (or null string pathname))
- (or (and (pathnamep pathname) (absolute-pathname-p pathname) (resolve-symlinks* pathname))
- (let* ((load-pathname (resolve-symlinks* (load-pathname))))
- (when (absolute-pathname-p load-pathname)
- (subpathname load-pathname pathname :type :directory)))))
+ (or (and (absolute-pathname-p pathname) (resolve-symlinks* pathname))
+ (let* ((load-pathname (load-pathname))
+ (load-absolute
+ (or (absolute-pathname-p load-pathname)
+ (let ((defaults (resolve-symlinks* *default-pathname-defaults*)))
+ (and (absolute-pathname-p defaults)
+ (merge-pathnames* load-pathname defaults))))))
+ (when (absolute-pathname-p load-absolute)
+ (resolve-symlinks*
+ (subpathname load-absolute pathname :type :directory))))))
;;; Component class
#p\"/home/me/cl/systems/\"
#p\"/usr/share/common-lisp/systems/\"))
-This is for backward compatibilily.
+This is for backward compatibility.
Going forward, we recommend new users should be using the source-registry.
")
-(defun* probe-asd (name defaults)
+(defun* probe-asd (name defaults &key truename)
(block nil
(when (directory-pathname-p defaults)
- (let* ((file (probe-file* (subpathname defaults name :type "asd"))))
+ (let* ((file (probe-file* (subpathname defaults name :type "asd") :truename truename)))
(when file
(return file)))
#-(or clisp genera) ; clisp doesn't need it, plain genera doesn't have read-sequence(!)
(block nil
(unwind-protect
(dolist (dir *central-registry*)
- (let ((defaults (eval dir)))
+ (let ((defaults (resolve-symlinks* (eval dir)))
+ directorized truenamized)
(when defaults
- (cond ((directory-pathname-p defaults)
- (let ((file (probe-asd name defaults)))
+ (cond ((and (directory-pathname-p defaults)
+ (absolute-pathname-p defaults))
+ (let* ((file (probe-asd name defaults :truename *resolve-symlinks*)))
(when file
(return file))))
(t
(let* ((*print-circle* nil)
(message
(format nil
- (compatfmt "~@<While searching for system ~S: ~3i~_~S evaluated to ~S which is not a directory.~@:>")
+ (compatfmt "~@<While searching for system ~S: ~3i~_~S evaluated to ~S which is not an absolute directory.~@:>")
system dir defaults)))
(error message))
(remove-entry-from-registry ()
:report "Remove entry from *central-registry* and continue"
(push dir to-remove))
+ (coerce-to-truename ()
+ :test (lambda (c) (declare (ignore c))
+ (setf truenamized (truename* defaults)))
+ :report (lambda (s)
+ (format s (compatfmt "~@<Coerce entry to truename ~S and continue.~@:>")
+ truenamized))
+ (push dir to-remove))
(coerce-entry-to-directory ()
+ :test (lambda (c) (declare (ignore c))
+ (and (not (directory-pathname-p defaults))
+ (directory-pathname-p
+ (setf directorized
+ (ensure-directory-pathname defaults)))))
:report (lambda (s)
(format s (compatfmt "~@<Coerce entry to ~a, replace ~a and continue.~@:>")
- (ensure-directory-pathname defaults) dir))
- (push (cons dir (ensure-directory-pathname defaults)) to-replace))))))))
+ directorized dir))
+ (push (cons dir directorized) to-replace))))))))
;; cleanup
(dolist (dir to-remove)
(setf *central-registry* (remove dir *central-registry*)))
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.118: Another System Definition Facility.
+;;; This is ASDF 2.26.119: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
;; Some implementations have precompiled ASDF systems,
;; so we must disable translations for implementation paths.
#+(or #|clozure|# ecl mkcl sbcl)
- ,@(let ((h (lisp-implementation-directory :truename t))) (when h `(((,h ,*wild-path*) ()))))
+ ,@(let ((h (resolve-symlinks* (lisp-implementation-directory))))
+ (when h `(((,h ,*wild-path*) ()))))
#+mkcl (,(translate-logical-pathname "CONTRIB:") ())
;; All-import, here is where we want user stuff to be:
:inherit-configuration
(when src
(let ((trusrc (or (eql src t)
(let ((loc (resolve-location src :ensure-directory t :wilden t)))
- (if (absolute-pathname-p loc) (truenamize loc) loc)))))
+ (if (absolute-pathname-p loc) (resolve-symlinks* loc) loc)))))
(cond
((location-function-p dst)
(funcall collect
((directory-pathname-p pathname)
(process-output-translations (validate-output-translations-directory pathname)
:inherit inherit :collect collect))
- ((probe-file* pathname)
+ ((probe-file* pathname :truename *resolve-symlinks*)
(process-output-translations (validate-output-translations-file pathname)
:inherit inherit :collect collect))
(t
(initialize-output-translations)))
(defun* apply-output-translations (path)
- #+cormanlisp (truenamize path) #-cormanlisp
+ #+cormanlisp (resolve-symlinks* path) #-cormanlisp
(etypecase path
(logical-pathname
path)
((or pathname string)
(ensure-output-translations)
- (loop :with p = (truenamize path)
+ (loop :with p = (resolve-symlinks* path)
:for (source destination) :in (car *output-translations*)
:for root = (when (or (eq source t)
(and (pathnamep source)
#:component-name-to-pathname-components
#:split-name-type #:parse-unix-namestring #:unix-namestring
#:split-unix-namestring-directory-components
- #:subpathname #:subpathname*
+ #:subpathname #:subpathname* #:subpathp
;; Resolving symlinks somewhat
#:truenamize #:resolve-symlinks #:resolve-symlinks*
;; Wildcard pathnames
(defun* truename* (p)
;; avoids both logical-pathname merging and physical resolution issues
- (ignore-errors (with-pathname-defaults () (truename p))))
+ (and p (ignore-errors (with-pathname-defaults () (truename p)))))
-(defun* probe-file* (p)
- "when given a pathname P, probes the filesystem for a file or directory
-with given pathname and if it exists return its truename."
+(defun* probe-file* (p &key truename)
+ "when given a pathname P (designated by a string as per PARSE-NAMESTRING),
+probes the filesystem for a file or directory with given pathname.
+If it exists, return its truename is ENSURE-PATHNAME is true,
+or the original (parsed) pathname if it is false (the default)."
(with-pathname-defaults () ;; avoids logical-pathname issues on some implementations
(etypecase p
(null nil)
- (string (probe-file* (parse-namestring p)))
+ (string (probe-file* (parse-namestring p) :truename truename))
(pathname (unless (wild-pathname-p p)
- #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks mkcl sbcl scl)
- '(probe-file p)
- #+clisp (if-let (it (find-symbol* '#:probe-pathname :ext nil))
- `(ignore-errors (,it p)))
- #+gcl<2.7
- '(or (probe-file p)
- (and (directory-pathname-p p)
- (ignore-errors
- (ensure-directory-pathname
- (truename* (subpathname (ensure-directory-pathname p) "."))))))
- '(truename* p)))))))
+ (let ((foundtrue
+ #.(or #+(or allegro clozure cmu cormanlisp ecl lispworks mkcl sbcl scl)
+ '(probe-file p)
+ #+clisp (if-let (it (find-symbol* '#:probe-pathname :ext nil))
+ `(ignore-errors (,it p)))
+ #+gcl<2.7
+ '(or (probe-file p)
+ (and (directory-pathname-p p)
+ (ignore-errors
+ (ensure-directory-pathname
+ (truename* (subpathname
+ (ensure-directory-pathname p) "."))))))
+ '(truename* p))))
+ (cond
+ (truename foundtrue)
+ (foundtrue p)
+ (t nil))))))))
(defun* safe-file-write-date (pathname)
;; If FILE-WRITE-DATE returns NIL, it's possible that
to throw an error if the pathname is absolute"
(block nil
(check-type type (or null string (eql :directory)))
- (when (eq type :directory)
- (setf ensure-directory t))
+ (when ensure-directory
+ (setf type :directory))
(etypecase name
((or null pathname) (return name))
(symbol
(string))
(multiple-value-bind (relative path filename file-only)
(split-unix-namestring-directory-components
- name :dot-dot dot-dot :ensure-directory ensure-directory)
+ name :dot-dot dot-dot :ensure-directory (eq type :directory))
(multiple-value-bind (name type)
(cond
- ((or ensure-directory (null filename))
+ ((or (eq type :directory) (null filename))
(values nil nil))
(type
(values filename type))
(and pathname
(subpathname (ensure-directory-pathname pathname) subpath :type type)))
+(defun* subpathp (maybe-subpath base-pathname)
+ (and (pathnamep maybe-subpath) (pathnamep base-pathname)
+ (absolute-pathname-p maybe-subpath) (absolute-pathname-p base-pathname)
+ (directory-pathname-p base-pathname) (not (wild-pathname-p base-pathname))
+ (with-pathname-defaults ()
+ (let ((enough (enough-namestring maybe-subpath base-pathname)))
+ (and (relative-pathname-p enough) (pathname enough))))))
+
;;; Pathname host and its root
(defun* pathname-root (pathname)
(make-pathname* :directory '(:absolute)
;;; absolute vs relative
-(defun* ensure-pathname-absolute (path)
+(defun* ensure-pathname-absolute (path &optional defaults)
(cond
((absolute-pathname-p path) path)
- ((stringp path) (ensure-pathname-absolute (pathname path)))
+ ((stringp path) (ensure-pathname-absolute (pathname path) defaults))
((not (pathnamep path)) (error "not a valid pathname designator ~S" path))
- (t (let ((resolved (resolve-symlinks path)))
- (assert (absolute-pathname-p resolved))
- resolved))))
+ ((absolute-pathname-p defaults) (merge-pathnames* path defaults))
+ (t (error "Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S"
+ path defaults))))
-(defun* relativize-directory-component (directory-component)
+(defun relativize-directory-component (directory-component)
(let ((directory (normalize-pathname-directory-component directory-component)))
(cond
((stringp directory)
want-non-wild want-wild wilden
want-file want-directory ensure-directory
want-existing ensure-directories-exist
- ensure-truename truenamize
+ truename resolve-symlinks truenamize
&aux (p pathname)) ;; mutable working copy, preserve original
"Coerces its argument into a PATHNAME,
optionally doing some transformations and checking specified constraints.
WILDEN merges the pathname with **/*.*.* if it is not wild
WANT-EXISTING checks that a file (or directory) exists with that pathname.
ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST.
-ENSURE-TRUENAME replaces the pathname by its truename, or errors if not possible.
+TRUENAME replaces the pathname by its truename, or errors if not possible.
+RESOLVE-SYMLINKS replaces the pathname by a variant with symlinks resolved by RESOLVE-SYMLINKS.
TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
(block nil
(flet ((report-error (keyword description &rest arguments)
"Could not make into an absolute pathname even after merging with ~S" defaults)
(check ensure-subpath (absolute-pathname-p defaults)
"cannot be checked to be a subpath of non-absolute pathname ~S" defaults)
- (check ensure-subpath (not (absolute-pathname-p (enough-namestring p defaults)))
- "is not a sub pathname of ~S" defaults)
+ (check ensure-subpath (subpathp p defaults) "is not a sub pathname of ~S" defaults)
(check want-file (file-pathname-p p) "Expected a file pathname")
(check want-directory (directory-pathname-p p) "Expected a directory pathname")
(transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p))
(check want-wild (wild-pathname-p p) "Expected a wildcard pathname")
(transform wilden (not (wild-pathname-p p)) (wilden p))
(when want-existing
- (let ((existing (probe-file* p)))
+ (let ((existing (probe-file* p :truename truename)))
(if existing
- (when (or ensure-truename truenamize)
+ (when truename
(return existing))
(err want-existing "Expected an existing pathname"))))
(when ensure-directories-exist (ensure-directories-exist p))
- (when ensure-truename
+ (when truename
(let ((truename (truename* p)))
(if truename
(return truename)
(err truename "Can't get a truename for pathname"))))
+ (transform resolve-symlinks () (resolve-symlinks p))
(transform truenamize () (truenamize p))
p))))
(defun* wrapping-source-registry ()
`(:source-registry
- #+(or ecl sbcl) (:tree ,(lisp-implementation-directory :truename t))
+ #+(or ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory)))
#+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
:inherit-configuration
#+cmu (:tree #p"modules:")
(defmethod process-source-registry ((pathname #-gcl<2.7 pathname #+gcl<2.7 t) &key inherit register)
(cond
((directory-pathname-p pathname)
- (let ((*here-directory* (truenamize pathname)))
+ (let ((*here-directory* (resolve-symlinks* pathname)))
(process-source-registry (validate-source-registry-directory pathname)
:inherit inherit :register register)))
- ((probe-file* pathname)
+ ((probe-file* pathname :truename *resolve-symlinks*)
(let ((*here-directory* (pathname-directory-pathname pathname)))
(process-source-registry (validate-source-registry-file pathname)
:inherit inherit :register register)))
(defmethod builtin-system-p ((s system))
(let* ((system (find-system s nil))
(sysdir (and system (component-pathname system)))
- (truesysdir (and sysdir (truename* sysdir)))
- (impdir (lisp-implementation-directory :truename t)))
- (and truesysdir impdir (pathname-match-p truesysdir (wilden impdir)) t)))
-
+ (truesysdir (truename* sysdir))
+ (impdir (lisp-implementation-directory))
+ (trueimpdir (truename* impdir)))
+ (and sysdir impdir
+ (or (subpathp sysdir impdir)
+ (subpathp truesysdir trueimpdir)))))
(bundle-1 (asdf:output-file op (find-system :test-bundle-1)))
(bundle-2 (asdf:output-file op (find-system :test-bundle-2))))
(DBG :test-bundle bundle-1 bundle-2)
- (asdf::delete-file-if-exists bundle-1)
- (asdf::delete-file-if-exists bundle-2)
- (asdf:operate 'asdf:load-fasl-op :test-bundle-2)
+ (delete-file-if-exists bundle-1)
+ (delete-file-if-exists bundle-2)
+ (operate 'load-fasl-op :test-bundle-2)
;; Check that the bundles were indeed created.
(assert (probe-file bundle-1))
(assert (probe-file bundle-2))
;; Check that the files were indeed loaded.
- (assert (symbol-value (asdf::find-symbol* :*file1* :test-package)))
- (assert (symbol-value (asdf::find-symbol* :*file3* :test-package)))))
+ (assert (symbol-value (find-symbol* :*file1* :test-package)))
+ (assert (symbol-value (find-symbol* :*file3* :test-package)))))
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test-force)
(let* ((file1 (asdf:compile-file-pathname* "file1"))
(make-pathname :name "fileMissing"
:type "lisp"
:defaults
- *default-pathname-defaults*)))
+ *test-directory*)))
(template-file (namestring
(make-pathname :name "file1"
:type "lisp"
:defaults
- *default-pathname-defaults*))))
+ *test-directory*))))
(asdf::concatenate-files (list template-file) missing-name)
(unless (probe-file missing-name)
(format t "File copy failed.~%"))
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:load-system 'test-module-depend)
;; test that it compiled
(with-test ()
(setf asdf:*central-registry* nil)
- (load (merge-pathnames "test-nested-components-1.asd"))
+ (load "test-nested-components-1.asd")
(print
(list
:a
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:operate 'asdf:load-op 'test-redundant-recompile)
;; test that it compiled
(let* ((file1 (asdf:compile-file-pathname* "file1"))
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(DBG "loading test-samedir-modules")
(asdf:operate 'asdf:load-op 'test-samedir-modules)
(let* ((file1 (asdf:compile-file-pathname* "file1"))
;;(trace asdf::source-file-type asdf::source-file-explicit-type)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:load-system 'test-source-file-type-1 :verbose t)
(assert (symbol-value (read-from-string "test-package::*test-tmp-cl*")))
(assert
(require :http-library)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
;; Compare the source files with local versions before loading them.
#+(and (or abcl scl) trust-the-net)
(flet ((compare (url local)
(load "script-support.lisp")
(load-asdf)
-(setf *central-registry* '(*default-pathname-defaults*))
-
(with-test ()
(def-test-system :versioned-system-1
- :pathname #.*default-pathname-defaults*
+ :pathname #.*test-directory*
:version "1.0")
(def-test-system :versioned-system-2
- :pathname #.*default-pathname-defaults*
+ :pathname #.*test-directory*
:version "1.1")
(def-test-system :versioned-system-3
- :pathname #.*default-pathname-defaults*
+ :pathname #.*test-directory*
:version "1.2")
(flet ((test (name v &optional (true t))
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:load-system 'test-weakly-depends-on-present)
;; The weakly-depended-on system, file3-only, should be loaded...
(let* ((file3 (asdf:compile-file-pathname* "file3"))
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(asdf:load-system 'test-weakly-depends-on-unpresent)
;; test that it compiled
(let* ((file1 (asdf:compile-file-pathname* "file1"))
(load "script-support.lisp")
(load-asdf)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(DBG "test2: loading test2b1")
(asdf:load-system 'test2b1)
(DBG "test2: file3 and file4 were compiled")
(ns1 (asdf::native-namestring fasl1))
(ns2 (asdf::native-namestring fasl2)))
(asdf:run-shell-command "rm -f ~A ~A" ns1 ns2)
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(DBG "should load file1 but not file2")
(asdf:load-system :test3)
(assert (probe-file fasl1))
(in-package :asdf-test)
(with-test ()
- (setf asdf:*central-registry* '(*default-pathname-defaults*))
(handler-case
(asdf:oos 'asdf:load-op 'system-does-not-exist)
(asdf:missing-component-of-version (c)
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
- (asdf-version "2.26.118")
+ (asdf-version "2.26.119")
(existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
common-lisp.net / projects/asdf/asdf.git / commitdiff
