;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File - run-tests.lisp
;; Description - Tester for student solutions
;; Author - Gail Anderson (ga at lostwithiel)
;; Created On - Tue Mar 14 19:19:08 2000
;; Last Modified On - Mon Jul 9 08:33:05 2001
;; Last Modified By - Gail Anderson (ga at lostwithiel)
;; Update Count - 485
;; Status - Unknown
;;
;; $Id: run-tests.lisp,v 1.1 2003/01/09 02:11:35 colin Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(in-package :solution-tests)
;;; Note that the user part of defex (in defex-user.lisp), plus the
;;; definitions and library loads (in defs-n-paths.lisp) should be
;;; loaded first. defs-n-paths should be edited to reflect current
;;; defaults, and to load any exercise specific library files. It
;;; should also load the test definitions.
;;; Create a student scorecard; caches information from other parts of
;;; exercise structure, and saves "scores" (i.e. the results of tests
;;; on the students' defined symbols). This is defined as a separate
;;; structure to provide an interface point for the test routines.
(defun create-student-scorecard (&optional (submission *current-submission*))
(setf (gethash (exercise-login-name submission) *scores*)
(make-student-scorecard
:login-name (exercise-login-name submission)
:author (exercise-author submission)
:load-error (exercise-load-error submission)
:loaded-comment (exercise-load-comment submission)
:compile-error (exercise-compile-error submission)
:compiled-comment (exercise-compile-comment submission)
:other-comments (exercise-other-comments submission)
:symbol-scores (mapcar #'(lambda (sym)
(cons sym nil))
(exercise-defined-symbols submission)))))
;;; print out a student scorecard
(defun print-student-scorecard (&optional (scorecard (gethash (exercise-login-name *current-submission*) *scores*))
&key (stream *standard-output*))
(let ((login-name (student-scorecard-login-name scorecard))
(author (student-scorecard-author scorecard))
(load-error (if (student-scorecard-load-error scorecard) "Yes" "No"))
(loaded-comment (student-scorecard-loaded-comment scorecard))
(compile-error (if (student-scorecard-compile-error scorecard) "Yes" "No"))
(compiled-comment (student-scorecard-compiled-comment scorecard))
(other-comments (student-scorecard-other-comments scorecard))
(symbol-scores (student-scorecard-symbol-scores scorecard)))
(with-html-output (stream)
(:h1 "Results of testing on " author "'s submission")
(:h2 "Login name: " login-name)
(:h2 "Comments:")
(:h4 "Did submission signal errors or warnings during load? " load-error)
(:h4 "Comments on any load errors or warnings:")
(:p loaded-comment)
(:h4 "Did submission signal errors or warnings during load? " compile-error)
(:h4 "Comments on any compile errors or warnings:")
(:p compiled-comment)
(:h4 "Any other comments on testing:")
(:p other-comments)
(:h2 "Test scores for symbols defined:")
(mapc
#'(lambda (fnrec)
(format stream "<p>~S: ~D out of ~D</p>~%"
(first fnrec) (second fnrec) (third fnrec)))
symbol-scores))))
;;; function for dispatching tests to the individual function testers
(defun test-function (test-details submission-file
&key (submission *current-submission*)
(stream *standard-output*))
(let ((func (first test-details))
(test-func (second test-details))
(initial-score (third test-details))
(library-file (fourth test-details))
(manual-info (fifth test-details))
score)
(with-html-output (stream)
(:h3 "Running automatic tests on "
func)
(clean-student-symbols)
(load submission-file)
(if library-file (load library-file))
(setf score (apply test-func (list initial-score :stream stream)))
(:h4 "Score for " func " automatic tests: " score " out of " initial-score)
(:h4 "Manual/Visual tests needed? ")
(:p manual-info)
(setf (cdr (assoc func (student-scorecard-symbol-scores
(gethash (exercise-login-name submission) *scores*))))
(list score initial-score)))))
;;; function for testing all of the students defined functions
(defun test-defined-symbols (submission submission-file &key (stream t))
(let ((fns (exercise-defined-symbols submission)))
(mapc #'(lambda (fn)
(let ((details
(assoc fn *test-detail-list*)))
(if details
(test-function
details
submission-file
:stream stream)
(format stream "~%~%****** WARNING: no test details for ~S~%~%" fn))))
fns)))
;;; function for testing a submission
(defun test-submission (basename submission-file output-file)
(load submission-file)
(let ((submission (gethash basename *submissions*)))
(setf (exercise-tests submission)
*test-detail-list*)
(with-open-file (str output-file
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
(with-html-output (str)
(:head)
(:body
(test-submission-aux submission submission-file str))))))
(defun test-submission-aux (submission submission-file output-stream)
(let ((author (exercise-author submission))
(login-name (exercise-login-name submission))
(load-error (exercise-load-error submission))
(load-comment (exercise-load-comment submission))
(compile-error (exercise-compile-error submission))
(compile-comment (exercise-compile-comment submission))
(other-comments (exercise-other-comments submission)))
(with-html-output (output-stream)
(:h1 "Reporting on " author " (" login-name ")'s" " Submission")
(:h3 "Errors when loaded? " load-error)
(:h3 "Comments on loading submission: " load-comment)
(:h3 "Errors when compiled? " compile-error)
(:h3 "Comments on compiling submission" compile-comment)
(:h3 "Any other comments: " other-comments)
(create-student-scorecard submission)
(test-defined-symbols submission submission-file :stream output-stream))))
(defun test-student-submission
(basename
&key (input-directory *submission-directory*)
(output-directory *submission-log-directory*)
(score-directory *submission-score-directory*))
(let ((input-file
(merge-pathnames
(make-pathname
:directory input-directory
:name (concatenate 'string basename *lisp-extn*))))
(output-file
(merge-pathnames
(make-pathname
:directory output-directory
:name (concatenate 'string basename *log-extn*))))
(scorecard-file
(merge-pathnames
(make-pathname
:directory score-directory
:name (concatenate 'string basename *score-extn*)))))
(ensure-directories-exist output-file)
(ensure-directories-exist scorecard-file)
(test-submission basename input-file output-file)
(with-open-file (stream scorecard-file :direction :output
:if-does-not-exist :create
:if-exists :supersede)
(print-student-scorecard
(gethash basename *scores*)
:stream stream))))
(defun test-all-students (&key (students *all-students*)
(input-directory *submission-directory*)
(output-directory *submission-log-directory*)
(score-directory *submission-score-directory*))
(mapc #'(lambda (std)
(test-student-submission std
:input-directory input-directory
:output-directory output-directory
:score-directory score-directory))
students)
(values))
;;; tests every solution
(defun run-tests ()
(with-open-file (out "all.out" :direction :output
:if-does-not-exist :create :if-exists :supersede)
(let ((*error-output* out))
(test-all-students))))