Commit ca006497 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Add docstring for LEAVE-TEST in test code.

parent 94ef1526
Loading
Loading
Loading
Loading
+18 −16
Original line number Original line Diff line number Diff line
@@ -32,9 +32,9 @@ Some constraints:
(in-package :asdf-test)
(in-package :asdf-test)


(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl genera) (debug 3)
(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl genera) (debug 3)
		   #+(or cmu scl) (c::brevity 2)))
                   #+(or cmu scl) (c::brevity 2)))
(proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl genera) (debug 3)
(proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl genera) (debug 3)
		     #+(or cmu scl) (c::brevity 2)))
                     #+(or cmu scl) (c::brevity 2)))


(defvar *trace-symbols*
(defvar *trace-symbols*
  `(;; If you want to trace some stuff while debugging ASDF,
  `(;; If you want to trace some stuff while debugging ASDF,
@@ -123,23 +123,23 @@ Some constraints:
     (format t "~S and ~S both evaluate to same path:~%  ~S~%" qx qy x))
     (format t "~S and ~S both evaluate to same path:~%  ~S~%" qx qy x))
    ((acall :pathname-equal x y)
    ((acall :pathname-equal x y)
     (warn "These two expressions yield pathname-equal yet not equal path~%~
     (warn "These two expressions yield pathname-equal yet not equal path~%~
	the first expression ~S yields this:~%  ~S~%  ~S~%
        the first expression ~S yields this:~%  ~S~%  ~S~%
	the other expression ~S yields that:~%  ~S~%  ~S~%"
        the other expression ~S yields that:~%  ~S~%  ~S~%"
	qx x (pathname-components x)
        qx x (pathname-components x)
	qy y (pathname-components y)))
        qy y (pathname-components y)))
    (t
    (t
     (error "These two expressions yield paths that are not pathname-equal~%~
     (error "These two expressions yield paths that are not pathname-equal~%~
	the first expression ~S yields this:~%  ~S~%  ~S~%
        the first expression ~S yields this:~%  ~S~%  ~S~%
	the other expression ~S yields that:~%  ~S~%  ~S~%"
        the other expression ~S yields that:~%  ~S~%  ~S~%"
	qx x (pathname-components x)
        qx x (pathname-components x)
	qy y (pathname-components y)))))
        qy y (pathname-components y)))))
(defmacro assert-pathname-equal (x y)
(defmacro assert-pathname-equal (x y)
  `(assert-pathname-equal-helper ',x ,x ',y ,y))
  `(assert-pathname-equal-helper ',x ,x ',y ,y))
(defun assert-length-equal-helper (qx x qy y)
(defun assert-length-equal-helper (qx x qy y)
  (unless (= (length x) (length y))
  (unless (= (length x) (length y))
    (error "These two expressions yield sequences of unequal length~%
    (error "These two expressions yield sequences of unequal length~%
	The first, ~S, has value ~S of length ~S~%
        The first, ~S, has value ~S of length ~S~%
	The other, ~S, has value ~S of length ~S~%"
        The other, ~S, has value ~S of length ~S~%"
           qx x (length x) qy y (length y))))
           qx x (length x) qy y (length y))))
(defun assert-pathnames-equal-helper (qx x qy y)
(defun assert-pathnames-equal-helper (qx x qy y)
  (assert-length-equal-helper qx x qy y)
  (assert-length-equal-helper qx x qy y)
@@ -259,15 +259,17 @@ Some constraints:
  #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
  #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
  #+mkcl (mk-ext:quit :exit-code code)
  #+mkcl (mk-ext:quit :exit-code code)
  #+sbcl #.(let ((exit (find-symbol "EXIT" :sb-ext))
  #+sbcl #.(let ((exit (find-symbol "EXIT" :sb-ext))
		 (quit* (find-symbol "QUIT" :sb-ext)))
                 (quit* (find-symbol "QUIT" :sb-ext)))
	     (cond
             (cond
	       (exit `(,exit :code code :abort t))
               (exit `(,exit :code code :abort t))
	       (quit* `(,quit* :unix-status code :recklessly-p t))))
               (quit* `(,quit* :unix-status code :recklessly-p t))))
  #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
  #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
  (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))
  (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))




(defun leave-test (message return)
(defun leave-test (message return)
  "Print MESSAGE and throw RETURN, which should be a POSIX error
code (an integer, 0 for success), up as exit code."
  (finish-outputs*)
  (finish-outputs*)
  (fresh-line *error-output*)
  (fresh-line *error-output*)
  (when message
  (when message