Skip to content
Snippets Groups Projects
Commit 087d0f1f authored by Gary King's avatar Gary King
Browse files

correct version finding code; rearrange to reduce warnings

The code for finding *asdf-revision* was borked when no tag was
present (i.e., when you got ASDF via git rather than via a download
or tarball). This is fixed.

Also moved some defuns around to reduce spurious warning under my
version of SBCL.
parent 10338c96
No related branches found
No related tags found
No related merge requests found
......@@ -122,7 +122,7 @@
(defvar *asdf-revision*
(let* ((v "$Format:%d$")
(to-find "tags/")
(tags (or (search to-find v :test #'char=) -1)))
(tags (search to-find v :test #'char=)))
(when (and v tags)
(let ((dot (position #\. v :start tags)))
(when dot
......@@ -366,6 +366,10 @@ and NIL NAME and TYPE components"
(string name)
(t (sysdef-error "~@<invalid component designator ~A~@:>" name))))
(defun system-registered-p (name)
(gethash (coerce-name name) *defined-systems*))
;;; for the sake of keeping things reasonably neat, we adopt a
;;; convention that functions in this list are prefixed SYSDEF-
......@@ -437,9 +441,6 @@ and NIL NAME and TYPE components"
(setf (gethash (coerce-name name) *defined-systems*)
(cons (get-universal-time) system)))
(defun system-registered-p (name)
(gethash (coerce-name name) *defined-systems*))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; finding components
......@@ -1169,6 +1170,47 @@ Returns the new tree (which probably shares structure with the old one)"
(defvar *serial-depends-on*)
(defun sysdef-error-component (msg type name value)
(sysdef-error (concatenate 'string msg
"~&The value specified for ~(~A~) ~A is ~W")
type name value))
(defun check-component-input (type name weakly-depends-on depends-on components in-order-to)
"A partial test of the values of a component."
(when weakly-depends-on (warn "We got one! XXXXX"))
(unless (listp depends-on)
(sysdef-error-component ":depends-on must be a list."
type name depends-on))
(unless (listp weakly-depends-on)
(sysdef-error-component ":weakly-depends-on must be a list."
type name weakly-depends-on))
(unless (listp components)
(sysdef-error-component ":components must be NIL or a list of components."
type name components))
(unless (and (listp in-order-to) (listp (car in-order-to)))
(sysdef-error-component ":in-order-to must be NIL or a list of components."
type name in-order-to)))
(defun %remove-component-inline-methods (ret rest)
(loop for name in +asdf-methods+
do (map 'nil
;; this is inefficient as most of the stored
;; methods will not be for this particular gf n
;; But this is hardly performance-critical
(lambda (m)
(remove-method (symbol-function name) m))
(component-inline-methods ret)))
;; clear methods, then add the new ones
(setf (component-inline-methods ret) nil)
(loop for name in +asdf-methods+
for v = (getf rest (intern (symbol-name name) :keyword))
when v do
(destructuring-bind (op qual (o c) &body body) v
(pushnew
(eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
,@body))
(component-inline-methods ret)))))
(defun parse-component-form (parent options)
(destructuring-bind
......@@ -1247,47 +1289,6 @@ Returns the new tree (which probably shares structure with the old one)"
ret)))
(defun %remove-component-inline-methods (ret rest)
(loop for name in +asdf-methods+
do (map 'nil
;; this is inefficient as most of the stored
;; methods will not be for this particular gf n
;; But this is hardly performance-critical
(lambda (m)
(remove-method (symbol-function name) m))
(component-inline-methods ret)))
;; clear methods, then add the new ones
(setf (component-inline-methods ret) nil)
(loop for name in +asdf-methods+
for v = (getf rest (intern (symbol-name name) :keyword))
when v do
(destructuring-bind (op qual (o c) &body body) v
(pushnew
(eval `(defmethod ,name ,qual ((,o ,op) (,c (eql ,ret)))
,@body))
(component-inline-methods ret)))))
(defun check-component-input (type name weakly-depends-on depends-on components in-order-to)
"A partial test of the values of a component."
(when weakly-depends-on (warn "We got one! XXXXX"))
(unless (listp depends-on)
(sysdef-error-component ":depends-on must be a list."
type name depends-on))
(unless (listp weakly-depends-on)
(sysdef-error-component ":weakly-depends-on must be a list."
type name weakly-depends-on))
(unless (listp components)
(sysdef-error-component ":components must be NIL or a list of components."
type name components))
(unless (and (listp in-order-to) (listp (car in-order-to)))
(sysdef-error-component ":in-order-to must be NIL or a list of components."
type name in-order-to)))
(defun sysdef-error-component (msg type name value)
(sysdef-error (concatenate 'string msg
"~&The value specified for ~(~A~) ~A is ~W")
type name value))
(defun resolve-symlinks (path)
#-allegro (truename path)
#+allegro (excl:pathname-resolve-symbolic-links path)
......@@ -1321,16 +1322,16 @@ output to `*verbose-out*`. Returns the shell's exit code."
:input nil :output *verbose-out*))
#+allegro
;;?? will fail if command has embedded quotes
(multiple-value-bind (stdout stderr exit-code)
(excl.osi:command-output
(format nil "~a -c ~a" #+mswindows "sh" #-mswindows "/bin/sh" command)
(format nil "~a -c \"~a\"" #+mswindows "sh" #-mswindows "/bin/sh" command)
:input nil :whole t
#+mswindows :show-window #+mswindows :hide)
(format *verbose-out* "~{~&; ~a~%~}~%" stderr)
(format *verbose-out* "~{~&; ~a~%~}~%" stdout)
exit-code)
#+lispworks
(system:call-system-showing-output
command
......
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