Commit 71437300 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

ASDF 1.602: pass more tests.

* made it easier to debug tests. export DEBUG_ASDF_TEST=t
* add ECL support to tests: passes all 18 scripts, but have to ignore compile warnings.
* lots of whitespace issues, including ones that made .gitignore not work!
parent b575ccb3
Loading
Loading
Loading
Loading
+3 −4
Original line number Diff line number Diff line
@@ -12,7 +12,6 @@ test/conf.d/
test/dir1/
test/dir2/


# We build these at various stages in the make process
LICENSE
website/output/
@@ -21,9 +20,9 @@ tmp/
lift-local.config
*.dribble
*.fasl
*.dfsl 
*.cfsl 
*.fas 
*.dfsl
*.cfsl
*.fas
*.lib
*.o
*.*fsl
+9 −8
Original line number Diff line number Diff line
@@ -63,7 +63,7 @@
      (let ((sym (find-symbol "*ASDF-REVISION*" asdf)))
        (when sym
          (unexport sym asdf)
          (unintern sym))))))
          (unintern sym asdf))))))

#+ecl (require 'cmp)

@@ -187,7 +187,7 @@
;;;;
(defparameter *asdf-version*
  ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
  (subseq "VERSION:1.601" (1+ (length "VERSION"))))
  (subseq "VERSION:1.602" (1+ (length "VERSION"))))

(defun asdf-version ()
  *asdf-version*)
@@ -679,7 +679,7 @@ and NIL NAME and TYPE components" ;;; what about VERSION???
(defun component-parent-pathname (component)
  (aif (component-parent component)
       (component-pathname it)
       *default-pathname-defaults*))
       (truename *default-pathname-defaults*)))

(defmethod component-relative-pathname ((component module))
  (or (slot-value component 'relative-pathname)
@@ -690,8 +690,8 @@ and NIL NAME and TYPE components" ;;; what about VERSION???
         :host (pathname-host (component-parent-pathname component))))))

(defmethod component-pathname ((component component))
  (let ((*default-pathname-defaults* (component-parent-pathname component)))
    (merge-pathnames (component-relative-pathname component))))
  (merge-pathnames (component-relative-pathname component)
                   (component-parent-pathname component)))

(defmethod component-property ((c component) property)
  (cdr (assoc property (slot-value c 'properties) :test #'equal)))
@@ -932,6 +932,7 @@ to `~a` which is not a directory.~@:>"

;;; a component with no parent is a system
(defmethod find-component ((module (eql nil)) name &optional version)
  (declare (ignorable module))
  (let ((m (find-system name nil)))
    (if (and m (version-satisfies m version)) m)))

@@ -988,7 +989,7 @@ to `~a` which is not a directory.~@:>"
(defmethod shared-initialize :after ((operation operation) slot-names
                                     &key force
                                     &allow-other-keys)
  (declare (ignore slot-names force))
  (declare (ignorable operation slot-names force))
  ;; empty method to disable initarg validity checking
  )

@@ -2188,8 +2189,8 @@ with a different configuration, so the configuration would be re-read then."
(defmethod process-output-translations ((x null) &key
                                    (inherit *default-output-translations*)
                                    collect)
  (declare (ignorable x))
  (inherit-output-translations inherit :collect collect))

(defmethod process-output-translations ((form cons) &key
                                        (inherit *default-output-translations*)
                                        collect)
@@ -2505,8 +2506,8 @@ with a different configuration, so the configuration would be re-read then."
(defmethod process-source-registry ((x null) &key
                                    (inherit *default-source-registries*)
                                    collect)
  (declare (ignorable x))
  (inherit-source-registry inherit :collect collect))

(defmethod process-source-registry ((form cons) &key
                                    (inherit *default-source-registries*)
                                    collect)
+3 −3
Original line number Diff line number Diff line
@@ -12,11 +12,11 @@
             (compile-file "asdf.lisp"))
         (declare (ignore result))
         (cond (warnings-p
                (leave-lisp "Testuite failed: ASDF compiled with warnings" 1))
                #-ecl ;;; ECL gives warnings that it shouldn't!
                (leave-lisp "Testsuite failed: ASDF compiled with warnings" 1))
               (errors-p
                (leave-lisp "Testuite failed: ASDF compiled with ERRORS" 2))
                (leave-lisp "Testsuite failed: ASDF compiled with ERRORS" 2))
               (t
                (leave-lisp "ASDF compiled cleanly" 0)))))
      (t
       (leave-lisp "Testsuite failed: unable to find ASDF source" 3)))
+8 −8
Original line number Diff line number Diff line
@@ -15,7 +15,7 @@ http://ilc2009.scheming.org/
  (already-compiled :initarg :already-compiled :reader test-already-compiled)
  (expected :initarg :expected :reader test-expected)))

(defmacro define-test (test-name system-name 
(defmacro define-test (test-name system-name
                       &key operation-name already-compiled expected)
 `(progn
    (push ',test-name *all-tests*)
@@ -34,7 +34,7 @@ http://ilc2009.scheming.org/

(defmethod asdf:operation-done-p ((o asdf:compile-op) (c test-file))
 (declare (ignorable o))
 (member (asdf:component-name c) (test-already-compiled *test*) 
 (member (asdf:component-name c) (test-already-compiled *test*)
          :test #'string=))

(defmethod asdf:operation-done-p ((o asdf:operation) (c test-file))
@@ -70,7 +70,7 @@ http://ilc2009.scheming.org/
                (first steps) *steps*)))
     ;(format t "~2%STEPS: ~S~3%" *steps*)
     (dolist (expectation (test-expected *test*))
        (destructuring-bind (op file &rest at) 
        (destructuring-bind (op file &rest at)
            expectation
          ;(format t "~2%Expectation: ~S~3%" expectation)
          (check-type file string)
@@ -81,8 +81,8 @@ http://ilc2009.scheming.org/
                 (fail "~S was not ~A" file op)
                 (loop for (relationship file2) on at by #'cddr do
                   (check-type file2 string)
                   (let* ((op2 (ecase relationship 
                                 (:after-loading :loaded) 
                   (let* ((op2 (ecase relationship
                                 (:after-loading :loaded)
                                 (:after-compiling :compiled)))
                          (pos2 (position (cons op2 file2) *steps*
                                          :test #'equal)))
@@ -92,7 +92,7 @@ http://ilc2009.scheming.org/
                           ((< pos pos2)
                            (fail "Wrong order between ~A of ~S and ~A of ~S"
                                  op file op2 file2))))))))
            (:did-not-compile 
            (:did-not-compile
             (when (member (cons :compiled file) *steps*)
               (fail "~A compiled but should not have" file)))
            (:did-not-load
@@ -147,7 +147,7 @@ http://ilc2009.scheming.org/
 :operation-name asdf:load-op
 :already-compiled ()
 :expected ((:compiled "a" :after-compiling "g" :after-compiling "k"
                        :after-compiling "h" :after-loading "g" 
                        :after-compiling "h" :after-loading "g"
                        :after-loading "k" :after-loading "h")
             (:loaded "a" :after-compiling "a")
             (:compiled "b")
@@ -213,7 +213,7 @@ http://ilc2009.scheming.org/
(asdf:defsystem system-5
 :components ((:test-file "a")
               (:test-file "b" :depends-on ("a")
                               :in-order-to ((asdf:compile-op 
                               :in-order-to ((asdf:compile-op
                                              (asdf:load-op "a"))))))

(define-test test-5 system-5
+1 −1
Original line number Diff line number Diff line
;;; -*- Lisp -*-
(load "script-support")
(load "../asdf")
(exit-on-error 
(exit-on-error
 (setf asdf:*central-registry* '(*default-pathname-defaults*))
 (in-package :asdf)
 (setf asdf::*load-preference-files* t)
Loading