Commit aae7de4a authored by Gary King's avatar Gary King
Browse files

Added test results to website

* new file - test/make-webpage.lisp

* added `test-all` target to run tests on all the lisps the test system knows about

* added test-results.html to website with link from index

* documentation tweaks
parent 92b2ebaa
Loading
Loading
Loading
Loading
+15 −0
Original line number Diff line number Diff line
@@ -7,6 +7,12 @@ clnet_home := "/project/asdf/public_html/"

sourceDirectory := $(shell pwd)

lisps = allegro allegromodern ccl clisp sbcl 

ifndef lisp
lisp := sbcl
endif

# website, tag, install

install: archive-copy
@@ -39,4 +45,13 @@ clean: FORCE
	     fi; \
	done

test: FORCE
	@cd test; ./run-tests.sh $(lisp) $(test-regex)
	echo "My foot is $?"

test-all: FORCE
	@for lisp in $(lisps); do \
		make test lisp=$$lisp; \
	done
	sbcl --userinit /dev/null --sysinit /dev/null --load test/make-webpage.lisp --eval "(quit)"
FORCE:
 No newline at end of file
+10 −1
Original line number Diff line number Diff line
;;; This is asdf: Another System Definition Facility. 
;;; hash - $Format:%H$
;;;
;;; Local Variables:
;;; mode: lisp
;;; End:
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <asdf-devel@common-lisp.net>.  But note first that the canonical
;;; source for asdf is presently on common-lisp.net at
@@ -1085,7 +1089,12 @@ it from disk).
The traverse operation is wrapped in `with-compilation-unit` and error
handling code. If a `version` argument is supplied, then operate also
ensures that the system found satisfies it using the `version-satisfies`
method."))
method.

Note that dependencies may cause the operation to invoke other
operations on the system or its components: the new operations will be
created with the same initargs as the original one.
"))
  (setf (documentation 'oos 'function)
	(format nil
		"Short for _operate on system_ and an alias for the [operate][] function. ~&~&~a"
+82 −81
Original line number Diff line number Diff line
@@ -4,6 +4,38 @@
#+(or)
(build-web-page "/repository/git/asdf/test/results/" "/tmp/x.html" :if-exists :supersede)

(defun extract-summary (pathname stream)
  (with-open-file (in pathname :direction :input
		      :if-does-not-exist :error)
    (let ((start nil))
      (loop for line = (read-line in nil :eof)
	 until (eq line :eof) do
	 (when (and (> (length line) 5) (string-equal "-#---" (subseq line 0 5)))
	   (setf start t))
	 (when start
	   (format stream "~&~a~%" line))))))

(defun html-header (stream title style-sheet)
  (format stream "~&<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
        \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
  (format stream "~&<html>~&<head>")
  (when title
    (format stream "~&<title>~a</title>" title))
  (when style-sheet 
    (unless (search ".css" style-sheet)
      (setf style-sheet (concatenate 'string style-sheet ".css")))
    (format stream "~&<link type='text/css' href='~a' rel='stylesheet' />"
	    style-sheet))
  (format stream "~&</head>~&<body>"))

(defun html-footer (stream)
  (format stream "<div id=\"footer\">")
  (format stream "~&generated on ~a"
	  (format-date "%B %d, %Y" (get-universal-time)))
  (format stream "</div>")
  (format stream "~&</body></html>"))


(defun build-web-page (input-directory output-file &key (if-exists :error)
		       (title "ASDF test report") (style-sheet "styles.css"))
  (with-open-file (stream output-file
@@ -24,17 +56,6 @@
    (html-footer stream)
    ))

(defun extract-summary (pathname stream)
  (with-open-file (in pathname :direction :input
		      :if-does-not-exist :error)
    (let ((start nil))
      (loop for line = (read-line in nil :eof)
	 until (eq line :eof) do
	 (when (and (> (length line) 5) (string-equal "-#---" (subseq line 0 5)))
	   (setf start t))
	 (when start
	   (format stream "~&~a~%" line))))))

;;; metatilities-base 
;;; because sometimes copy and paste is just too easy

@@ -64,6 +85,56 @@
(defparameter +days-per-month+
  '(31 28 31 30 31 30 31 31 30 31 30 31))


(defun days-in-month (month &optional leap-year?)
  "Returns the number of days in the specified month. The month should be
between 1 and 12."
  (+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0)))

(defun leap-year-p (year)
  "Returns t if the specified year is a leap year. I.e. if the year
is divisible by four but not by 100 or if it is divisible by 400."
  (or (and (= (mod year 4) 0)               ; logand is faster but less perspicuous
           (not (= (mod year 100) 0)))
      (= (mod year 400) 0)))

(defun day-of-year (date)
  "Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]" 
  (let ((leap-year? (leap-year-p (time-year date))))
    (+ (loop for month from 1 to (1- (time-month date)) sum
             (days-in-month month leap-year?))
       (time-date date))))

(defconstant +longer-format-index+ 0)
(defconstant +shorter-format-index+ 1)

(defparameter +month-output-list+
  '(("January" "February" "March" "April" "May" "June" "July" "August" "September"
     "October" "November" "December")
    ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))

(defparameter +dow-output-list
  '(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
    ("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))

(defun day->string (day-of-the-week &optional (format :long))
  "Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day."
  (check-type day-of-the-week (mod 7))
  (check-type format (member :long :short))
  (nth day-of-the-week 
       (case format
	 (:long (nth +longer-format-index+ +dow-output-list))
	 (:short (nth +shorter-format-index+ +dow-output-list)))))

(defun month->string (month &optional (format :long))
  "Returns the name \(in English\) of the month. Format can be :long or :short."
  (check-type month (integer 1 12))
  (check-type format (member :long :short))
  (nth (1- month) 
       (case format
	 (:long (nth +longer-format-index+ +month-output-list+))
	 (:short (nth +shorter-format-index+ +month-output-list+)))))

(defun format-date (format date &optional stream time-zone)
  "Formats universal dates using the same format specifiers as NSDateFormatter. The format is:

@@ -162,78 +233,8 @@ None of %c, %F, %p, %x, %X, %Z, %z are implemented."
		  (error "Ouch - unknown formatter '%~c" char))))
	      (t char)))))))


(defun days-in-month (month &optional leap-year?)
  "Returns the number of days in the specified month. The month should be
between 1 and 12."
  (+ (nth (1- month) +days-per-month+) (if (and (= month 2) leap-year?) 1 0)))

(defun leap-year-p (year)
  "Returns t if the specified year is a leap year. I.e. if the year
is divisible by four but not by 100 or if it is divisible by 400."
  (or (and (= (mod year 4) 0)               ; logand is faster but less perspicuous
           (not (= (mod year 100) 0)))
      (= (mod year 400) 0)))

(defun day-of-year (date)
  "Returns the day of the year [1 to 366] of the specified date [which must be \(CL\) universal time format.]" 
  (let ((leap-year? (leap-year-p (time-year date))))
    (+ (loop for month from 1 to (1- (time-month date)) sum
             (days-in-month month leap-year?))
       (time-date date))))

(defconstant +longer-format-index+ 0)
(defconstant +shorter-format-index+ 1)

(defparameter +month-output-list+
  '(("January" "February" "March" "April" "May" "June" "July" "August" "September"
     "October" "November" "December")
    ("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec")))

(defparameter +dow-output-list
  '(("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")
    ("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun")))

(defun day->string (day-of-the-week &optional (format :long))
  "Returns the name of `day-of-the-week`. The parameter should be a number between 0 and 6 where 0 represents Sunday and 6 repressents Saturday. The optional format argument can be either :long or :short. In the latter case, the return string will be of length three; in the former it will be the complete name of the appropriate day."
  (check-type day-of-the-week (mod 7))
  (check-type format (member :long :short))
  (nth day-of-the-week 
       (case format
	 (:long (nth +longer-format-index+ +dow-output-list))
	 (:short (nth +shorter-format-index+ +dow-output-list)))))

(defun month->string (month &optional (format :long))
  "Returns the name \(in English\) of the month. Format can be :long or :short."
  (check-type month (integer 1 12))
  (check-type format (member :long :short))
  (nth (1- month) 
       (case format
	 (:long (nth +longer-format-index+ +month-output-list+))
	 (:short (nth +shorter-format-index+ +month-output-list+)))))

;;; metatilites-base

(defun html-header (stream title style-sheet)
  (format stream "~&<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
        \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
  (format stream "~&<html>~&<head>")
  (when title
    (format stream "~&<title>~a</title>" title))
  (when style-sheet 
    (unless (search ".css" style-sheet)
      (setf style-sheet (concatenate 'string style-sheet ".css")))
    (format stream "~&<link type='text/css' href='~a' rel='stylesheet' />"
	    style-sheet))
  (format stream "~&</head>~&<body>"))

(defun html-footer (stream)
  (format stream "<div id=\"footer\">")
  (format stream "~&generated on ~a"
	  (format-date "%B %d, %Y" (get-universal-time)))
  (format stream "</div>")
  (format stream "~&</body></html>"))

(let* ((*default-pathname-defaults* (make-pathname :name nil :type nil :defaults *load-truename*))
       (source (merge-pathnames
		(make-pathname
+12 −3
Original line number Diff line number Diff line
@@ -48,6 +48,7 @@ if [ $? -eq 0 ] ; then
      fi
    done
    echo >&2
    echo "-#---------------------------------------" >&2
    echo "Using $1" >&2
    echo "Ran $test_count tests: " >&2
    echo "  $test_pass passing and $test_fail failing" >&2
@@ -56,6 +57,7 @@ if [ $? -eq 0 ] ; then
    else
	echo "failing test(s): $failed_list" >&2
    fi
    echo "-#---------------------------------------" >&2
    echo >&2
fi
}
@@ -71,7 +73,7 @@ fi
if [ "$lisp" = "sbcl" ] ; then 
    if type sbcl ; then
      fasl_ext="fasl"
      command="sbcl --userinit /dev/null --sysinit /dev/null --noprogrammer"
      command="sbcl --userinit /dev/null --sysinit /dev/null --noinform --noprogrammer"
    fi
elif [ "$lisp" = "clisp" ] ; then
    if type clisp ; then
@@ -89,6 +91,11 @@ elif [ "$lisp" = "allegromodern" ] ; then
	fasl_ext="fasl"
	command="mlisp -q --batch "
    fi
elif [ "$lisp" = "ccl" ] ; then
    if type ccl ; then
	fasl_ext="fasl"
	command="ccl --no-init --quiet --batch "
    fi
fi


@@ -99,9 +106,11 @@ fi


if [ -z "$command" ] ; then
    echo "Error: don't know how to run Lisp named $lisp"
    echo "Error: cannot find or do not know how to run Lisp named $lisp"
else
    mkdir -p results
    echo $command
    do_tests "$command" $fasl_ext
    thedate=`date "+%Y-%m-%d"`
    do_tests "$command" $fasl_ext 2>&1 | tee "results/${lisp}.text" "results/${lisp}-${thedate}.save"
fi
 
+4 −4
Original line number Diff line number Diff line
@@ -22,8 +22,8 @@ system and for operating on these components in the right
order so that they can be compiled, loaded, tested, etc.

ASDF presents two faces: one for system implementors who need
to be able to describe their systems using ASDF and one for
Lisp programmers and users who want to use those systems.
to be able to describe their systems and one for
Lisp programmers who want to use those systems.
This document describes ASDF for the second audience. If you
want to build your own systems with ASDF, then you'll also
want to read the ASDF [system definition guide][sys-guide].
@@ -51,7 +51,7 @@ Once you load it in a running Lisp, you're ready to go. For
maximum convenience you will want to have ASDF loaded
whenever you start your Lisp. check your 
implementation's manual for details on how to load it from
the startup script or creating a custom Lisp image.-
the startup script or creating a custom Lisp image.

### Using

@@ -95,7 +95,7 @@ To use ASDF:
* load `asdf.lisp` into your Lisp image,

* make sure ASDF can find system definitions by loading them
  yourself or setting up `asdf:*central-registry*`,
  yourself or setting up [`asdf:*central-registry*`][*central-registry*],

* use [operate][] to tell ASDF what you'd like to
  do to what systems (for simple operations, you can use
Loading