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
Loading
Loading
Loading
Loading
+48 −47
Original line number Diff line number Diff line
@@ -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