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 the submission is considered successful, so this function should
avoid throwing an exception (it can, but the submission will avoid throwing an exception (it can, but the submission will
still be in place). This is useful for things like notifying 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. sending a `receipt' email.
To specify only pre/post-checker, use #f for the one you want to To specify only pre/post-checker, use #f for the one you want to
omit. 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 > (message string [styles]) - if given only a string, this string will
be shown on the client's submission dialog; if `styles' is also 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' given, it can be the symbol 'final, which will be used as the text
dialog on the client side, and the resulting value is returned as on the handin dialog after a successful submission (useful for
the result of `message'. You can use that to send warnings to the submissions that were saved, but had problems); finally, `styles'
student and wait for confirmation. 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-run-status string-or-#f) - registers information about the
current actions of the checker, in case the session is terminated 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 with a ";;> " prefix too. Defaults to a single line: "Maximum
points for this assignment: <+100>". 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 * :value-printer -- if specified, this will be used for
`current-value-printer' (see above). `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 will often try to submit their work alone, and later on re-submit
with a partner. 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) > (procedure/arity? proc arity)
Returns #t if `proc' is a procedure that accepts `arity' arguments. 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 ;; without this the primitive eval is not available
(provide (rename eval prim-eval)) (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:) (provide check:)
(define-syntax (check: stx) (define-syntax (check: stx)
(define (id s) (datum->syntax-object stx s stx)) (define (id s) (datum->syntax-object stx s stx))
@ -225,6 +232,8 @@
[value-printer* (get ':value-printer #'#f)] [value-printer* (get ':value-printer #'#f)]
[coverage?* (get ':coverage? #'#f)] [coverage?* (get ':coverage? #'#f)]
[output* (get ':output #'"hw.scm")] [output* (get ':output #'"hw.scm")]
[user-error-message*
(get ':user-error-message #'"Error in your code --\n~a")]
[checker (id 'checker)] [checker (id 'checker)]
[users (id 'users)] [users (id 'users)]
[submission (id 'submission)] [submission (id 'submission)]
@ -259,6 +268,7 @@
[value-printer value-printer*] [value-printer value-printer*]
[coverage? coverage?*] [coverage? coverage?*]
[output-file output*] [output-file output*]
[user-error-message user-error-message*]
[execute-counts #f]) [execute-counts #f])
;; ======================================== ;; ========================================
;; verify submitting users ;; verify submitting users
@ -282,40 +292,63 @@
;; ======================================== ;; ========================================
;; convert to text, evaluate, check ;; convert to text, evaluate, check
(define (check users submission) (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? (when create-text?
(current-run-status "creating your files on the server")
(make-directory "grading") (make-directory "grading")
(let ([str (submission->string (when (regexp-match #rx";>" submission-text)
submission maxwidth textualize?)]) (error* "You cannot use \";>\" in your code!"))
(when (regexp-match #rx";>" str) (write-text))
(error* "You cannot use \";>\" in your code!")) (when value-printer (current-value-printer value-printer))
(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 coverage? (coverage-enabled #t)) (when coverage? (coverage-enabled #t))
(current-run-status "checking submission") (current-run-status "checking submission")
(cond (cond
[language [language
(call-with-evaluator/submission (let ([eval
language teachpacks submission (with-handlers
(lambda (eval) ([void
(when coverage? (lambda (e)
(set! execute-counts (eval #f 'execute-counts))) (let ([m (if (exn? e)
(current-run-status "running tests") (exn-message e)
(parameterize ([submission-eval eval]) (format "~a" e))])
(let-syntax ([with-submission-bindings (cond
(syntax-rules () [(procedure? user-error-message)
[(_ bindings body1 (... ...)) (user-error-message m)]
(with-bindings eval bindings [(not (string? user-error-message))
body1 (... ...))])]) (error*
(let () body ...)))))] "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] [(not eval?) #t]
[else (error* "no language configured for submissions")]) [else (error* "no language configured for submissions")])
output-file) output-file)

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

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