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/
+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)))
+42 −16
Original line number Diff line number Diff line
@@ -26,9 +26,11 @@ fi
sok=1

do_tests() {
rm -f *.$2 || true
( cd .. && echo '(load "test/compile-asdf.lisp")' | $1  )
  command=$1 eval=$2 fasl_ext=$3
  rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true
  ( cd .. && $command $eval '(load "test/compile-asdf.lisp")' )
  if [ $? -eq 0 ] ; then
    echo "Compiled OK"
    test_count=0
    test_pass=0
    test_fail=0
@@ -37,12 +39,12 @@ if [ $? -eq 0 ] ; then
    do
      echo "Testing: $i" >&2
      test_count=`expr "$test_count" + 1`
      rm -f *.$2 || true
      if  $1 < $i ; then
        echo "Using $1, $i passed" >&2
      rm -f *.$fasl_ext ~/.cache/common-lisp/"`pwd`"/*.$fasl_ext || true
      if $command $eval "(load \"$i\")" ; then
        echo "Using $command, $i passed" >&2
	test_pass=`expr "$test_pass" + 1`
      else
        echo "Using $1, $i failed" >&2
        echo "Using $command, $i failed" >&2
	test_fail=`expr "$test_fail" + 1`
	failed_list="$failed_list $i"
        sok=0
@@ -50,7 +52,7 @@ if [ $? -eq 0 ] ; then
    done
    echo >&2
    echo "-#---------------------------------------" >&2
    echo "Using $1" >&2
    echo "Using $command" >&2
    echo "Ran $test_count tests: " >&2
    echo "  $test_pass passing and $test_fail failing" >&2
    if [ $test_fail -eq 0 ] ; then
@@ -75,23 +77,31 @@ case "$lisp" in
  sbcl)
    if type sbcl ; then
      fasl_ext="fasl"
      command="sbcl --userinit /dev/null --sysinit /dev/null --noinform --noprogrammer"
      command="sbcl --noinform --userinit /dev/null --sysinit /dev/null"
      nodebug="--disable-debugger"
      eval="--eval"
    fi ;;
  clisp)
    if type clisp ; then
	fasl_ext="fas"
	command=`which clisp`
	command="$command -norc -ansi -I - "
	command="$command -norc -ansi -I "
        nodebug="-on-error exit"
        eval="-x"
    fi ;;
  allegro)
    if type alisp ; then
	fasl_ext="fasl"
	command="alisp -q -batch "
	command="alisp -q "
        nodebug="-batch"
        eval="-eval"
    fi ;;
  allegromodern)
    if type mlisp ; then
	fasl_ext="fasl"
	command="mlisp -q -batch "
	command="mlisp -q"
        nodebug="-batch"
        eval="-eval"
    fi ;;
  ccl)
    if type ccl ; then
@@ -104,15 +114,30 @@ case "$lisp" in
          i?86|ppc) fasl_bits=32 ;;
        esac
        fasl_ext="${fasl_os}${fasl_bits}fsl"
	command="ccl --no-init --quiet --batch "
	command="ccl --no-init --quiet"
        nodebug="--batch"
        eval="--eval"
    fi ;;
  cmucl)
    if type lisp ; then
	fasl_ext="x86f"
	command="lisp -batch -noinit"
	command="lisp -noinit"
        nodebug="-batch"
        eval="-eval"
    fi ;;
  ecl)
    if type ecl ; then
	fasl_ext="fas"
	command=`which ecl`
	command="$command -norc"
        eval="-eval"
    fi ;;
esac

if [ -z "${DEBUG_ASDF_TEST}" ] ; then
  command="$command $nodebug"
fi

create_asds () {
    mkdir -p {conf.d,dir1,dir2/{dir3,dir4}}
    for i in dir1 dir2; do touch "$i"/test.asd; done
@@ -131,6 +156,7 @@ else
    mkdir -p results
    echo $command
    thedate=`date "+%Y-%m-%d"`
    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
    do_tests "$command" "$eval" "$fasl_ext" 2>&1 | \
	tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
    clean_up
fi
+8 −3
Original line number Diff line number Diff line
@@ -28,9 +28,14 @@
  (error "Don't know how to quit Lisp; wanting to use exit code ~a" return))

(defmacro quit-on-error (&body body)
  `(handler-case
      (progn ,@body
  `(call-quitting-on-error (lambda () ,@body)))

(defun call-quitting-on-error (thunk)
  (handler-case
      (progn (funcall thunk)
             (leave-lisp "~&Script succeeded~%" 0))
    (error (c)
      (format *error-output* "~a" c)
      (leave-lisp "~&Script failed~%" 1))))
      (if (ignore-errors (funcall (find-symbol "GETENV" :asdf) "DEBUG_ASDF_TEST"))
          (break)
          (leave-lisp "~&Script failed~%" 1)))))
Loading