suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

* Added a (message "..." 'final) that can be used to leave a message when

Browse Source 
handin is done.
* Added `add-header-line' and a `:user-error-message' option to extra-utils.ss

svn: r1025
This commit is contained in:
Eli Barzilay 2005-10-09 00:56:06 +00:00
parent b06cb9a2fc
commit e323d15247
3 changed files with 108 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
collects/handin-server/doc.txt
View File

@ -418,7 +418,7 @@ sub-directories:
the submission is considered successful, so this function should
avoid throwing an exception (it can, but the submission will
still be in place). This is useful for things like notifying
the user of the successful submission (see message below), or
the user of the successful submission (see `message' below), or
sending a `receipt' email.
To specify only pre/post-checker, use #f for the one you want to
omit.
@ -605,10 +605,13 @@ The _utils.ss_ module provides utilities helpful in implementing
> (message string [styles]) - if given only a string, this string will
be shown on the client's submission dialog; if `styles' is also
given, it will be used as a list of styles for a `message-box'
dialog on the client side, and the resulting value is returned as
the result of `message'. You can use that to send warnings to the
student and wait for confirmation.
given, it can be the symbol 'final, which will be used as the text
on the handin dialog after a successful submission (useful for
submissions that were saved, but had problems); finally, `styles'
can be used as a list of styles for a `message-box' dialog on the
client side, and the resulting value is returned as the result of
`message'. You can use that to send warnings to the student and
wait for confirmation.
> (current-run-status string-or-#f) - registers information about the
current actions of the checker, in case the session is terminated
@ -710,6 +713,36 @@ Keywords for configuring `check:':
with a ";;> " prefix too. Defaults to a single line: "Maximum
points for this assignment: <+100>".
* :user-error-message -- a string that is used to report an error that
occured during evaluation of the submitted code (not during
additional tests). It can be a plain string which will be used as
the error message, or a string with single a "~a" (or "~e", "~s",
"~v") that will be used as a format string with the actual error
message. Examples of these:
"there is an error in your program, hit \"Run\" and debug your code"
"There is an error in your program:\n----\n~a\n----\n
Hit \"Run\" and debug your code."
Alternatively, the value can be a procedure that will be invoked
with the error message. The procedure can do anything it wants, and
if it does not raise an exception, then the checker will proceed as
usual. For example:
(lambda (msg)
(add-header-line! "Erroneous submission!")
(add-header-line! (format " --> ~a" msg))
(message (string-append
"You have an error in your program -- please hit"
" \"Run\" and debug your code.\n"
"Email the course staff if you think your code is fine.\n"
"(The submission has been saved but marked as erroneous.)")
'(ok))
(message "Handin saved as erroneous." 'final))
(Note that if you do this, then additional tests should be
adjusted to not raise an exception too.)
* :value-printer -- if specified, this will be used for
`current-value-printer' (see above).
@ -789,6 +822,11 @@ value from the submission code.
will often try to submit their work alone, and later on re-submit
with a partner.
> (add-header-line! line)
During the checker operation, this procedure can be used to add
header lines to the text version of the submitted file. It will not
have an effect if `:create-text?' is false.
> (procedure/arity? proc arity)
Returns #t if `proc' is a procedure that accepts `arity' arguments.

89
collects/handin-server/extra-utils.ss
View File

@ -193,6 +193,13 @@
;; without this the primitive eval is not available
(provide (rename eval prim-eval))
;; for adding lines in the checker
(define added-lines (make-thread-cell #f))
(provide add-header-line!)
(define (add-header-line! line)
(let ([new (list line)] [cur (thread-cell-ref added-lines)])
(if cur (append! cur new) (thread-cell-set! added-lines new))))
(provide check:)
(define-syntax (check: stx)
(define (id s) (datum->syntax-object stx s stx))
@ -225,6 +232,8 @@
[value-printer* (get ':value-printer #'#f)]
[coverage?* (get ':coverage? #'#f)]
[output* (get ':output #'"hw.scm")]
[user-error-message*
(get ':user-error-message #'"Error in your code --\n~a")]
[checker (id 'checker)]
[users (id 'users)]
[submission (id 'submission)]
@ -259,6 +268,7 @@
[value-printer value-printer*]
[coverage? coverage?*]
[output-file output*]
[user-error-message user-error-message*]
[execute-counts #f])
;; ========================================
;; verify submitting users
@ -282,40 +292,63 @@
;; ========================================
;; convert to text, evaluate, check
(define (check users submission)
(when value-printer (current-value-printer value-printer))
(define text-file "grading/text.scm")
(define (write-text)
(with-output-to-file text-file
(lambda ()
(define added (or (thread-cell-ref added-lines) '()))
(for-each
(lambda (user)
(printf ";;> ~a\n" (user-substs user student-line)))
users)
(for-each (lambda (l) (printf ";;> ~a\n" l)) extra-lines)
(for-each (lambda (l) (printf ";;> ~a\n" l)) added)
(display submission-text))
'truncate))
(define submission-text
(and create-text?
(submission->string submission maxwidth textualize?)))
(when create-text?
(current-run-status "creating your files on the server")
(make-directory "grading")
(let ([str (submission->string
submission maxwidth textualize?)])
(when (regexp-match #rx";>" str)
(error* "You cannot use \";>\" in your code!"))
(with-output-to-file "grading/text.scm"
(lambda ()
(for-each
(lambda (user)
(printf ";;> ~a\n" (user-substs user student-line)))
users)
(for-each (lambda (l) (printf ";;> ~a\n" l))
extra-lines)
(display str)))))
(when (regexp-match #rx";>" submission-text)
(error* "You cannot use \";>\" in your code!"))
(write-text))
(when value-printer (current-value-printer value-printer))
(when coverage? (coverage-enabled #t))
(current-run-status "checking submission")
(cond
[language
(call-with-evaluator/submission
language teachpacks submission
(lambda (eval)
(when coverage?
(set! execute-counts (eval #f 'execute-counts)))
(current-run-status "running tests")
(parameterize ([submission-eval eval])
(let-syntax ([with-submission-bindings
(syntax-rules ()
[(_ bindings body1 (... ...))
(with-bindings eval bindings
body1 (... ...))])])
(let () body ...)))))]
(let ([eval
(with-handlers
([void
(lambda (e)
(let ([m (if (exn? e)
(exn-message e)
(format "~a" e))])
(cond
[(procedure? user-error-message)
(user-error-message m)]
[(not (string? user-error-message))
(error*
"badly configured user-error-message")]
[(regexp-match #rx"~[aesvAESV]"
user-error-message)
(error* user-error-message m)]
[else
(error* "~a" user-error-message)])))])
(call-with-evaluator/submission
language teachpacks submission values))])
(when coverage?
(set! execute-counts (eval #f 'execute-counts)))
(current-run-status "running tests")
(parameterize ([submission-eval eval])
(let-syntax ([with-submission-bindings
(syntax-rules ()
[(_ bindings body*1 body* (... ...))
(with-bindings eval bindings
body*1 body* (... ...))])])
(let () body ...))
(when (thread-cell-ref added-lines) (write-text))))]
[(not eval?) #t]
[else (error* "no language configured for submissions")])
output-file)

6
collects/handin-server/handin-server.ss
View File

@ -252,8 +252,10 @@
(case-lambda
[(msg) (write+flush w 'message msg)]
[(msg styles)
(write+flush w 'message-box msg styles)
(read (make-limited-input-port r 50))])])
(if (eq? 'final styles)
(write+flush w 'message-final msg)
(begin (write+flush w 'message-box msg styles)
(read (make-limited-input-port r 50))))])])
;; Clear out old ATTEMPT, if any, and make a new one:
(when (directory-exists? ATTEMPT-DIR)
(delete-directory/files ATTEMPT-DIR))