run-tests.lisp Unix DownloadWindows Download
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- 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))))