;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; File		     - defs-n-paths.lisp
;; Description	     - Tester for student solutions
;; Author	     - Gail Anderson (ga at lostwithiel)
;; Created On	     - Tue Mar 14 19:19:08 2000
;; Last Modified On  -  Tue Jul 10 02:09:20 2001
;; Last Modified By  - Gail Anderson (ga at lostwithiel)
;; Update Count	     - 441
;; Status	     - Unknown
;; 
;; $Id: defs-n-paths.lisp,v 1.2 2003/01/23 09:04:20 colin Exp $
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package :solution-tests)


;;; use htout

(eval-when (compile load eval)
  (use-package :htout))

;;; Contains all the definitions and load commands needed to set up
;;; the tester's environment for testing solutions to a particular
;;; exercise

;;; pathname defaults ; these are merged with the current value of
;;; *default-pathname-defaults*

(defparameter *submission-directory* '(:relative "submissions"))
(defparameter *submission-log-directory* '(:relative "submission-logs"))
(defparameter *submission-score-directory* '(:relative "submission-scores"))

(defparameter *total-sheet*
    (merge-pathnames
     (make-pathname
     :directory *submission-score-directory*
     :name "totals")))


;;; extensions to filenames

(defparameter *lisp-extn* ".lisp")
(defparameter *log-extn* ".html")
(defparameter *score-extn* ".html")


;;; Here, provide a list of pathnames of any test data, auxiliary test
;;; functions, or libraries needed to test the students' solutions;
;;; these should be pre-compiled

(defparameter *libs* nil)  ; etc.

(if *libs*
    (mapc #'load *libs*))


;;; Here, define *all-students* to be a list of the basenames of all
;;; the student solutions to be tested. These should live in the
;;; *submission-directory*

(defparameter *all-students* '("student"))

;;; global parameter which stores all the scorecards for all solutions
;;; tested

(defparameter *scores* (make-hash-table :test #'equalp))

;;; structure to score a student's final marks. This is defined as a
;;; separate structure (stored in a slot of the exercise structure) to
;;; provide an interface point for the test routines.

(defstruct student-scorecard 
  login-name
  author
  load-error
  loaded-comment
  compile-error
  compiled-comment
  other-comments
  symbol-scores)


;;; Macro for testing a particular call, and printing out the result.

;;; This has to be defined BEFORE the exercise-specific tests are loaded.


(defmacro test-call (num call expected comment &key (test #'equalp) print (stream t))
  `(progn
     (if *libs*
	 (mapc #'load *libs*))
     (let* ((args (rest ',call))
	    result
	    success)
       (multiple-value-bind (res err warn)
	   (block catch-warnings
	     (let ((warnings '()))
	       (handler-bind ((warning #'(lambda (w)
					   (push w warnings)))
			      (error #'(lambda (e)
					 (return-from catch-warnings
					   (values nil e warnings)))))
		 (let ((r ,call))
		   (values r nil warnings)))))
	 (cond ((eql ,expected ':ERROR)
		(if err (setf success t))
		(setf result err))
	       ((eql ,expected ':WARNING)
		(if warn (setf success t))
		(setf result warn))
	       (t
		(setf result res)
		(setf success (funcall ,test result ,expected)))))
       
       (if success
	   (with-html-output (,stream)
	     (:p
	      (format ,stream "Test ~D (~A): ~S successfully returned (or signalled) ~S with arguments: ~S"
		      ,num 
		      (format nil ,comment)
		      ',call
		      result
		      args)))
	   (with-html-output (,stream)
	     (:p
	      (format ,stream "********* FAULT ON TEST ~D (~A): ~S returned (or signalled): ~S instead of: ~S with arguments: ~S"
		      ,num
		      (format nil ,comment)
		      ',call
		      (if ,print (funcall ,print result) result)
		      (if ,print (funcall ,print ,expected) ,expected)
		      args)))))))