Update asdf from the cclan upstream
... also adjust the up target, since SF changed their nameserver
such that the old version didn't work.
- cvs -d :pserver:anonymous@cvs.cclan.sf.net:/cvsroot/cclan \
+ cvs -d :pserver:anonymous@cvs.sf.net:/cvsroot/cclan \
co -kv -p asdf/asdf.lisp >/tmp/$$$$ &&\
mv /tmp/$$$$ asdf.lisp
co -kv -p asdf/asdf.lisp >/tmp/$$$$ &&\
mv /tmp/$$$$ asdf.lisp
- cvs -d :pserver:anonymous@cvs.cclan.sf.net:/cvsroot/cclan \
+ cvs -d :pserver:anonymous@cvs.sf.net:/cvsroot/cclan \
co -kv -p asdf/README >/tmp/$$$$ &&\
mv /tmp/$$$$ README
co -kv -p asdf/README >/tmp/$$$$ &&\
mv /tmp/$$$$ README
-README,v 1.35 2003/08/05 23:00:32 kevinrosenberg Exp -*- Text -*-
+$Id$ -*- Text -*-
+
+The canonical documentation for asdf is in the file asdf.texinfo.
+The significant overlap between this file and that will one day be
+resolved by deleting text from this file; in the meantime, please look
+there before here.
+
asdf: another system definition facility
asdf: another system definition facility
if the user loads up the .asd file into his editor and
interactively re-evaluates that form
if the user loads up the .asd file into his editor and
interactively re-evaluates that form
It is an error to define a system incorrectly: an implementation may
detect this and signal a generalised instance of
It is an error to define a system incorrectly: an implementation may
detect this and signal a generalised instance of
+SYSTEM-DEFINITION-ERROR.
Operations may go wrong (for example when source files contain
errors). These are signalled using generalised instances of
Operations may go wrong (for example when source files contain
errors). These are signalled using generalised instances of
+OPERATION-ERROR, with condition readers ERROR-COMPONENT and
+ERROR-OPERATION for the component and operation which erred.
* Compilation error and warning handling
* Compilation error and warning handling
This uses unexported symbols. What would be a nice interface for this
functionality?
This uses unexported symbols. What would be a nice interface for this
functionality?
+** patches
+
+Sometimes one wants to
+
+
* missing bits in implementation
** all of the above
* missing bits in implementation
** all of the above
-;;; This is asdf: Another System Definition Facility. 1.79
+;;; This is asdf: Another System Definition Facility. $Revision$
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
#:feature ; sort-of operation
#:version ; metaphorically sort-of an operation
#:feature ; sort-of operation
#:version ; metaphorically sort-of an operation
- #:output-files #:perform ; operation methods
+ #:input-files #:output-files #:perform ; operation methods
#:operation-done-p #:explain
#:component #:source-file
#:operation-done-p #:explain
#:component #:source-file
#:component-version
#:component-parent
#:component-property
#:component-version
#:component-parent
#:component-property
-(defvar *asdf-revision* (let* ((v "1.79")
+(defvar *asdf-revision* (let* ((v "$Revision$")
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
((component :reader error-component :initarg :component)
(operation :reader error-operation :initarg :operation))
(:report (lambda (c s)
((component :reader error-component :initarg :component)
(operation :reader error-operation :initarg :operation))
(:report (lambda (c s)
- (format s (formatter "~@<erred while invoking ~A on ~A~@:>")
+ (format s "~@<erred while invoking ~A on ~A~@:>"
(error-operation c) (error-component c)))))
(define-condition compile-error (operation-error) ())
(define-condition compile-failed (compile-error) ())
(define-condition compile-warned (compile-error) ())
(defclass component ()
(error-operation c) (error-component c)))))
(define-condition compile-error (operation-error) ())
(define-condition compile-failed (compile-error) ())
(define-condition compile-warned (compile-error) ())
(defclass component ()
- ((name :type string :accessor component-name :initarg :name :documentation
- "Component name, restricted to portable pathname characters")
+ ((name :accessor component-name :initarg :name :documentation
+ "Component name: designator for a string composed of portable pathname characters")
(version :accessor component-version :initarg :version)
(in-order-to :initform nil :initarg :in-order-to)
;;; XXX crap name
(version :accessor component-version :initarg :version)
(in-order-to :initform nil :initarg :in-order-to)
;;; XXX crap name
;;;; methods: conditions
(defmethod print-object ((c missing-dependency) s)
;;;; methods: conditions
(defmethod print-object ((c missing-dependency) s)
- (format s (formatter "~@<~A, required by ~A~@:>")
- (call-next-method c nil)
- (missing-required-by c)))
+ (format s "~@<~A, required by ~A~@:>"
+ (call-next-method c nil) (missing-required-by c)))
(defun sysdef-error (format &rest arguments)
(error 'formatted-system-definition-error :format-control format :format-arguments arguments))
(defun sysdef-error (format &rest arguments)
(error 'formatted-system-definition-error :format-control format :format-arguments arguments))
;;;; methods: components
(defmethod print-object ((c missing-component) s)
;;;; methods: components
(defmethod print-object ((c missing-component) s)
- (format s (formatter "~@<component ~S not found~
- ~@[ or does not match version ~A~]~
- ~@[ in ~A~]~@:>")
+ (format s "~@<component ~S not found~
+ ~@[ or does not match version ~A~]~
+ ~@[ in ~A~]~@:>"
(missing-requires c)
(missing-version c)
(when (missing-parent c)
(missing-requires c)
(missing-version c)
(when (missing-parent c)
(component (component-name name))
(symbol (string-downcase (symbol-name name)))
(string name)
(component (component-name name))
(symbol (string-downcase (symbol-name name)))
(string name)
- (t (sysdef-error (formatter "~@<invalid component designator ~A~@:>")
- name))))
+ (t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
;;; for the sake of keeping things reasonably neat, we adopt a
;;; convention that functions in this list are prefixed SYSDEF-
;;; for the sake of keeping things reasonably neat, we adopt a
;;; convention that functions in this list are prefixed SYSDEF-
(when (and on-disk
(or (not in-memory)
(< (car in-memory) (file-write-date on-disk))))
(when (and on-disk
(or (not in-memory)
(< (car in-memory) (file-write-date on-disk))))
- (let ((*package* (make-package (gensym (package-name #.*package*))
+ (let ((*package* (make-package (gensym #.(package-name *package*))
:use '(:cl :asdf))))
(format *verbose-out*
:use '(:cl :asdf))))
(format *verbose-out*
- (formatter "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%")
+ "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%"
;; FIXME: This wants to be (ENOUGH-NAMESTRING
;; ON-DISK), but CMUCL barfs on that.
on-disk
;; FIXME: This wants to be (ENOUGH-NAMESTRING
;; ON-DISK), but CMUCL barfs on that.
on-disk
(if error-p (error 'missing-component :requires name))))))
(defun register-system (name system)
(if error-p (error 'missing-component :requires name))))))
(defun register-system (name system)
- (format *verbose-out*
- (formatter "~&~@<; ~@;registering ~A as ~A~@:>~%") system name)
+ (format *verbose-out* "~&~@<; ~@;registering ~A as ~A~@:>~%" system name)
(setf (gethash (coerce-name name) *defined-systems*)
(cons (get-universal-time) system)))
(setf (gethash (coerce-name name) *defined-systems*)
(cons (get-universal-time) system)))
(defmethod perform ((operation operation) (c source-file))
(sysdef-error
(defmethod perform ((operation operation) (c source-file))
(sysdef-error
- (formatter "~@<required method PERFORM not implemented~
- for operation ~A, component ~A~@:>")
+ "~@<required method PERFORM not implemented ~
+ for operation ~A, component ~A~@:>"
(class-of operation) (class-of c)))
(defmethod perform ((operation operation) (c module))
nil)
(defmethod explain ((operation operation) (component component))
(class-of operation) (class-of c)))
(defmethod perform ((operation operation) (c module))
nil)
(defmethod explain ((operation operation) (component component))
- (format *verbose-out* "~&;;; ~A on ~A~%"
- operation component))
+ (format *verbose-out* "~&;;; ~A on ~A~%" operation component))
;;; perform is required to check output-files to find out where to put
;;; its answers, in case it has been overridden for site policy
(defmethod perform ((operation compile-op) (c cl-source-file))
;;; perform is required to check output-files to find out where to put
;;; its answers, in case it has been overridden for site policy
(defmethod perform ((operation compile-op) (c cl-source-file))
(let ((source-file (component-pathname c))
(output-file (car (output-files operation c))))
(multiple-value-bind (output warnings-p failure-p)
(let ((source-file (component-pathname c))
(output-file (car (output-files operation c))))
(multiple-value-bind (output warnings-p failure-p)
(when warnings-p
(case (operation-on-warnings operation)
(:warn (warn
(when warnings-p
(case (operation-on-warnings operation)
(:warn (warn
- (formatter "~@<COMPILE-FILE warned while ~
- performing ~A on ~A.~@:>")
+ "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>"
operation c))
(:error (error 'compile-warned :component c :operation operation))
(:ignore nil)))
(when failure-p
(case (operation-on-failure operation)
(:warn (warn
operation c))
(:error (error 'compile-warned :component c :operation operation))
(:ignore nil)))
(when failure-p
(case (operation-on-failure operation)
(:warn (warn
- (formatter "~@<COMPILE-FILE failed while ~
- performing ~A on ~A.~@:>")
+ "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>"
operation c))
(:error (error 'compile-failed :component c :operation operation))
(:ignore nil)))
operation c))
(:error (error 'compile-failed :component c :operation operation))
(:ignore nil)))
(error 'compile-error :component c :operation operation)))))
(defmethod output-files ((operation compile-op) (c cl-source-file))
(error 'compile-error :component c :operation operation)))))
(defmethod output-files ((operation compile-op) (c cl-source-file))
- (list (compile-file-pathname (component-pathname c))))
+ #-:broken-fasl-loader (list (compile-file-pathname (component-pathname c)))
+ #+:broken-fasl-loader (list (component-pathname c)))
(defmethod perform ((operation compile-op) (c static-file))
nil)
(defmethod perform ((operation compile-op) (c static-file))
nil)
(retry ()
:report
(lambda (s)
(retry ()
:report
(lambda (s)
- (format s
- (formatter "~@<Retry performing ~S on ~S.~@:>")
+ (format s "~@<Retry performing ~S on ~S.~@:>"
op component)))
(accept ()
:report
(lambda (s)
(format s
op component)))
(accept ()
:report
(lambda (s)
(format s
- (formatter "~@<Continue, treating ~S on ~S as ~
- having been successful.~@:>")
+ "~@<Continue, treating ~S on ~S as ~
+ having been successful.~@:>"
op component))
(setf (gethash (type-of op)
(component-operation-times component))
op component))
(setf (gethash (type-of op)
(component-operation-times component))
(defun class-for-type (parent type)
(defun class-for-type (parent type)
- (let ((class (find-class
- (or (find-symbol (symbol-name type) *package*)
- (find-symbol (symbol-name type) #.*package*)) nil)))
+ (let ((class
+ (find-class
+ (or (find-symbol (symbol-name type) *package*)
+ (find-symbol (symbol-name type) #.(package-name *package*)))
+ nil)))
(or class
(and (eq type :file)
(or (module-default-component-class parent)
(find-class 'cl-source-file)))
(or class
(and (eq type :file)
(or (module-default-component-class parent)
(find-class 'cl-source-file)))
- (sysdef-error (formatter "~@<don't recognize component type ~A~@:>")
- type))))
+ (sysdef-error "~@<don't recognize component type ~A~@:>" type))))
(defun maybe-add-tree (tree op1 op2 c)
"Add the node C at /OP1/OP2 in TREE, unless it's there already.
(defun maybe-add-tree (tree op1 op2 c)
"Add the node C at /OP1/OP2 in TREE, unless it's there already.
(ccl:run-program "/bin/sh" (list "-c" command)
:input nil :output *verbose-out*
:wait t)))
(ccl:run-program "/bin/sh" (list "-c" command)
:input nil :output *verbose-out*
:wait t)))
-
- #-(or openmcl clisp lispworks allegro scl cmu sbcl)
+ #+ecl ;; courtesy of Juan Jose Garcia Ripoll
+ (si:system command)
+ #-(or openmcl clisp lispworks allegro scl cmu sbcl ecl)
(error "RUN-SHELL-PROGRAM not implemented for this Lisp")
))
(error "RUN-SHELL-PROGRAM not implemented for this Lisp")
))
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)