:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
- :version "2.26.104" ;; to be automatically updated by bin/bump-revision
+ :version "2.26.105" ;; 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))))
(describe (find-system :asdf))
(defparameter *ad* (find-system :asdf-driver))
-(defparameter *asdf-directory* (system-source-directory *ad*))
-(defparameter *version*
- (safe-read-first-file-form (subpathname *asdf-directory* "version.lisp-expr")))
-
-(DBG :foo *ad* *version* (asdf-version))
-
+(defparameter *asdf-dir*
+ (ensure-pathname (system-source-directory *ad*)
+ :want-existing t :want-absolute t))
+(defun apath (x) (subpathname *asdf-dir* x))
+(defun ann (x) (native-namestring (apath x)))
+(defparameter *build-dir* (apath "build/"))
+(defparameter /build-dir/ (ann "build/"))
+(defun bpath (x) (subpathname *build-dir* x))
+(defun bnn (x) (native-namestring (bpath x)))
(defparameter *files*
- (append
- (loop :for c :in (operated-components *ad*
- :goal-operation 'load-op
- :keep-operation 'load-op)
- :for n = (enough-namestring (component-pathname c) *asdf-directory*)
- :when (typep c 'cl-source-file)
- :collect n)
- (list "version.lisp-expr" "asdf-driver.asd")))
-
-;; make asdf:
-;;;(run-program/ (list "make" "-C" (native-namestring *asdf-directory*) "build/asdf.lisp"))
-
-#|
-if [ -d "tmp" ]; then
- rm -r tmp
-fi
-mkdir tmp
-
-archive_file="tmp/asdf-$tag.tar.gz"
-echo "Create tmp/asdf.tar.gz with tag $tag"
-git archive $tag --prefix="asdf/" --format=tar | \
- gzip > $archive_file
-|#
\ No newline at end of file
+ (list* "asdf-driver.asd" "version.lisp-expr"
+ (loop :for c :in (operated-components
+ *ad* :goal-operation 'load-op
+ :keep-operation 'load-op)
+ :for n = (enough-namestring (component-pathname c)
+ *asdf-directory*)
+ :when (typep c 'cl-source-file)
+ :collect n)))
+(defparameter *version*
+ (safe-read-first-file-form (apath "version.lisp-expr")))
+(defparameter *name* (format nil "asdf-driver-~A" *version*))
+(defparameter *tarname* (strcat *name* ".tar.gz"))
+(defparameter dirname/ (strcat *name* "/"))
+(defparameter *destination*
+ (ensure-pathname (bpath dirname/)
+ :want-directory t :want-absolute t))
+(assert (< 6 (length (pathname-directory *destination*))))
+(defparameter /destination/ (native-namestring *destination*))
+(run-program/ `("rm" "-rf" ,/destination/))
+(ensure-directory-exists *destination*)
+(run-program/ `("ln" ,@(mapcar 'ann *files*) ,/destination/))
+(run-program/ (format nil "cd ~S && tar zcf ~S ~S"
+ ,/build-dir/, ,*tarname* ,dirname/))
+(run-program/ `("rm" "-rf" ,/destination/))
:inherit-configuration)))
(defun* resolve-relative-location-component (x &key want-directory wilden)
- (let* ((r (etypecase x
- (pathname x)
- (string (parse-unix-namestring
- x :want-directory want-directory))
- (cons
- (if (null (cdr x))
- (resolve-relative-location-component
- (car x) :want-directory want-directory :wilden wilden)
- (let* ((car (resolve-relative-location-component
- (car x) :want-directory t :wilden nil)))
- (merge-pathnames*
- (resolve-relative-location-component
- (cdr x) :want-directory want-directory :wilden wilden)
- car))))
- ((eql :*/) *wild-directory*)
- ((eql :**/) *wild-inferiors*)
- ((eql :*.*.*) *wild-file*)
- ((eql :implementation)
- (parse-unix-namestring
- (implementation-identifier) :want-directory t))
- ((eql :implementation-type)
- (parse-unix-namestring
- (string-downcase (implementation-type)) :want-directory t))
- ((eql :hostname)
- (parse-unix-namestring (hostname) :want-directory t))))
- (w (if (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*))))
- (wilden r)
- r)))
- (ensure-pathname w :want-relative t)))
+ (ensure-pathname
+ (etypecase x
+ (pathname x)
+ (string (parse-unix-namestring
+ x :want-directory want-directory))
+ (cons
+ (if (null (cdr x))
+ (resolve-relative-location-component
+ (car x) :want-directory want-directory :wilden wilden)
+ (let* ((car (resolve-relative-location-component
+ (car x) :want-directory t :wilden nil)))
+ (merge-pathnames*
+ (resolve-relative-location-component
+ (cdr x) :want-directory want-directory :wilden wilden)
+ car))))
+ ((eql :*/) *wild-directory*)
+ ((eql :**/) *wild-inferiors*)
+ ((eql :*.*.*) *wild-file*)
+ ((eql :implementation)
+ (parse-unix-namestring
+ (implementation-identifier) :want-directory t))
+ ((eql :implementation-type)
+ (parse-unix-namestring
+ (string-downcase (implementation-type)) :want-directory t))
+ ((eql :hostname)
+ (parse-unix-namestring (hostname) :want-directory t)))
+ :wilden (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*))))
+ :want-relative t))
(defvar *here-directory* nil
"This special variable is bound to the currect directory during calls to
(register-image-restore-hook 'compute-user-cache)
(defun* resolve-absolute-location-component (x &key want-directory wilden)
- (let* ((r (etypecase x
- (pathname x)
- (string
- (let ((p #-mcl (parse-namestring x)
- #+mcl (probe-posix x)))
- #+mcl (unless p (error "POSIX pathname ~S does not exist" x))
- (if want-directory (ensure-directory-pathname p) p)))
- (cons
- (return-from resolve-absolute-location-component
- (if (null (cdr x))
- (resolve-absolute-location-component
- (car x) :want-directory want-directory :wilden wilden)
- (merge-pathnames*
- (resolve-relative-location-component
- (cdr x) :want-directory want-directory :wilden wilden)
- (resolve-absolute-location-component
- (car x) :want-directory t :wilden nil)))))
- ((eql :root)
- ;; 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-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)
- r)))
- (ensure-pathname w :want-absolute t)))
+ (ensure-pathname
+ (etypecase x
+ (pathname x)
+ (string
+ (let ((p #-mcl (parse-namestring x)
+ #+mcl (probe-posix x)))
+ #+mcl (unless p (error "POSIX pathname ~S does not exist" x))
+ (if want-directory (ensure-directory-pathname p) p)))
+ (cons
+ (return-from resolve-absolute-location-component
+ (if (null (cdr x))
+ (resolve-absolute-location-component
+ (car x) :want-directory want-directory :wilden wilden)
+ (merge-pathnames*
+ (resolve-relative-location-component
+ (cdr x) :want-directory want-directory :wilden wilden)
+ (resolve-absolute-location-component
+ (car x) :want-directory t :wilden nil)))))
+ ((eql :root)
+ ;; 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-absolute-location-component
+ *here-directory* :want-directory t :wilden nil))
+ ((eql :user-cache) (resolve-absolute-location-component
+ *user-cache* :want-directory t :wilden nil)))
+ :wilden (and wilden (not (pathnamep x)))
+ :want-absolute t))
(defun* resolve-location (x &key want-directory wilden directory)
(when directory (setf want-directory t)) ;; :directory backward compatibility, until 2014-01-16.
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.104: Another System Definition Facility.
+;;; This is ASDF 2.26.105: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
(defun* ensure-pathname
(pathname &key want-pathname want-existing
- want-absolute want-relative want-directory want-file
- want-wild want-non-wild want-truename truenamize
- error-arguments)
+ want-absolute want-relative
+ want-logical want-physical ensure-physical
+ want-wild want-non-wild wilden
+ ensure-directory want-directory want-file
+ want-truename truenamize error-arguments)
"Coerces its argument into a PATHNAME, and checks specified constraints.
If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified.
If the argument is a STRING, it is first converted to a pathname via PARSE-NAMESTRING.
(string
(setf pathname (parse-namestring pathname)))
(pathname))
+ (when want-logical
+ (unless (typep pathname 'logical-pathname)
+ (err want-logical "Expected a logical pathname, got")))
+ (when want-physical
+ (unless (physical-pathname-p pathname)
+ (err want-physical "Expected a physical pathname, got")))
+ (when ensure-physical
+ (setf pathname (translate-logical-pathname pathname)))
(when want-absolute
(unless (absolute-pathname-p pathname)
(err want-absolute "Expected an absolute pathname, got")))
(when want-relative
(when (absolute-pathname-p pathname)
(err want-relative "Expected a relative pathname, got")))
- (when want-directory
- (unless (directory-pathname-p pathname)
- (err want-directory "Expected a directory pathname, got")))
- (when want-file
- (unless (pathname-name pathname)
- (err want-file "Expected a file pathname, got")))
(when want-wild
(unless (wild-pathname-p pathname)
(err want-wild "Expected a wildcard pathname, got")))
(when (or want-non-wild want-existing)
(when (wild-pathname-p pathname)
(err want-non-wild "Expected a non-wildcard pathname, got")))
+ (when (and wilden (not (wild-pathname-p pathname)))
+ (setf pathname (wilden pathname)))
+ (when ensure-directory
+ (setf pathname (ensure-directory-pathname pathname)))
+ (when want-directory
+ (unless (directory-pathname-p pathname)
+ (err want-directory "Expected a directory pathname, got")))
+ (when want-file
+ (unless (pathname-name pathname)
+ (err want-file "Expected a file pathname, got")))
(when want-existing
(let ((existing (probe-file* pathname)))
(if existing
- (err want-existing "Expected an existing pathname, got")
(when (or want-truename truenamize)
- (return existing)))))
+ (return existing))
+ (err want-existing "Expected an existing pathname, got"))))
(when want-truename
(let ((truename (truename* pathname)))
(if truename
;; "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.104")
+ (asdf-version "2.26.105")
(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
