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

* memory-limit also forbids large allocations now, remove warning

Browse Source 
* rename `current-run-status' -> `set-run-status'
* coverage should work fine with non-textual submissions
* added `current-error-message-tweaker', "checker.ss"-based checkers now use it
  to show which expression caused an error ("handin-server.ss" uses
  `tweak-error-message').  (This feature is a hack, and currently undocumented)

svn: r5415
This commit is contained in:
Eli Barzilay 2007-01-19 10:03:54 +00:00
parent fd4a4abe36
commit 4229e29035
5 changed files with 54 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/handin-server/checker.ss
View File

@ -328,6 +328,17 @@
(let ([new (list line)] [cur (thread-cell-ref added-lines)])
(if cur (append! cur new) (thread-cell-set! added-lines new))))
(define (wrap-evaluator eval)
(lambda (expr)
(current-error-message-tweaker
(lambda (msg) (format "~a, while evaluating ~s" msg expr)))
(begin0 (eval expr)
;; this will not happen if there was an error, so the above will still be
;; in -- but the problem is that some evaluations may intentionally raise
;; exception, so need to clear out this parameter anyway when done with
;; testing.
(current-error-message-tweaker #f))))
(provide check:)
(define-syntax (check: stx)
(define (id s) (datum->syntax-object stx s stx))
@ -427,7 +438,7 @@
;; ========================================
;; verify submitting users
(define (pre users submission)
(current-run-status "checking submission username(s)")
(set-run-status "checking submission username(s)")
(cond [(list? allowed)
(unless (member users allowed)
(error*
@ -453,7 +464,7 @@
(define (prefix-line/substs str)
(prefix-line (subst str generic-substs)))
(define (write-text)
(current-run-status "creating text file")
(set-run-status "creating text file")
(with-output-to-file text-file
(lambda ()
(for-each (lambda (user)
@ -467,7 +478,7 @@
'truncate))
(define submission-text
(and create-text?
(begin (current-run-status "reading submission")
(begin (set-run-status "reading submission")
((if multi-file
(unpack-multifile-submission
names-checker output-file)
@ -477,7 +488,7 @@
(when create-text? (make-directory "grading") (write-text))
(when value-printer (current-value-printer value-printer))
(when coverage? (coverage-enabled #t))
(current-run-status "checking submission")
(set-run-status "checking submission")
(cond
[(not eval?) (let () body ...)]
[language
@ -501,16 +512,18 @@
(error* "~a" user-error-message)])))])
(call-with-evaluator/submission
language teachpacks submission values))])
(current-run-status "running tests")
(parameterize ([submission-eval eval])
(set-run-status "running tests")
(parameterize ([submission-eval (wrap-evaluator eval)])
(let-syntax ([with-submission-bindings
(syntax-rules ()
[(_ bindings body*1 body* (... ...))
(with-bindings eval bindings
body*1 body* (... ...))])])
(let () body ...))
;; see the comment in `wrap-evaluator' for this:
(current-error-message-tweaker #f)
;; test coverage at the end (no harm if already done in
;; the checker since it's cheap)
;; the checker since it's cheap):
(when coverage? (!all-covered))
(when (thread-cell-ref added-lines) (write-text))))]
[else (error* "no language configured for submissions")])

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

@ -688,8 +688,7 @@ by this function.
multiple values, or raise an exception). Each of the two limits can
be `#f' to disable it.
(Note: memory limit requires running in a 3m executable; the limit
is only checked after a GC happens.)
(Note: memory limit requires running in a 3m executable.)
> (with-limits sec mb body ...)
A macro version of the above.
@ -716,7 +715,7 @@ _utils.ss_
paths, and initial definition content as supplied by input-program
(see `make-evaluator'). It also sets the current error-value print
handler to print values in a way suitable for `lang', it initializes
`current-run-status' with "executing your code", and it catches all
`set-run-status' with "executing your code", and it catches all
exceptions to re-raise them in a form suitable as a submission
error.
@ -773,7 +772,7 @@ _utils.ss_
`message'. You can use that to send warnings to the student and
wait for confirmation.
> (current-run-status string-or-#f)
> (set-run-status string-or-#f)
Registers information about the current actions of the checker, in
case the session is terminated due to excessive memory consumption.
For example, a checker might set the status to indicate which
@ -959,8 +958,7 @@ Keywords for configuring `check:':
This check happens after checker tests are run, but the information
is collected and stored before, so checker tests do not change the
result. Also, you can use the `!all-covered' procedure in the
checker before other tests, if you want that feedback earlier. Does
not work with non-textual submissions.
checker before other tests, if you want that feedback earlier.
Within the body of `check:', `users' and `submission' will be bound to
the checker arguments -- a (sorted) list of usernames and the

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

@ -631,9 +631,10 @@
;; Check protocol:
(with-handlers ([exn:fail?
(lambda (exn)
(let ([msg (if (exn? exn)
(exn-message exn)
(format "~e" exn))])
(let ([msg (tweak-error-message
(if (exn? exn)
(exn-message exn)
(format "~e" exn)))])
(kill-watcher)
(log-line "ERROR: ~a" msg)
(write+flush w msg)

27
collects/handin-server/private/run-status.ss
View File

@ -1,15 +1,30 @@
(module run-status mzscheme
(provide current-run-status-box set-run-status
current-messenger message
current-error-message-tweaker tweak-error-message)
;; current-run-status-box is used to let the client know where we are in the
;; submission process.
(define current-run-status-box (make-parameter #f))
(define (current-run-status s)
(let ([b (current-run-status-box)])
(when b (set-box! b s) (message s))))
;; current-messenget is a function that will send a message to the client.
(define current-messenger (make-parameter #f))
(define (message . args)
(let ([messenger (current-messenger)])
(and messenger (apply messenger args))))
(provide current-run-status-box current-run-status
current-messenger message))
;; Set the current-run-status-box and send a message.
(define (set-run-status s)
(let ([b (current-run-status-box)])
(when b (set-box! b s) (message s))))
;; current-error-message-tweaker is a function that is used to change an
;; error message that is sent to the user. Typical use is to add "while
;; evaluating ..." to messages.
(define current-error-message-tweaker (make-parameter #f))
(define (tweak-error-message msg)
(let ([t (current-error-message-tweaker)])
(if t (t msg) msg)))
)

9
collects/handin-server/utils.ss
View File

@ -23,9 +23,10 @@
call-with-evaluator
call-with-evaluator/submission
reraise-exn-as-submission-problem
current-run-status
set-run-status
message
current-value-printer
current-error-message-tweaker
check-proc
check-defined
@ -106,8 +107,8 @@
(map (lambda (a) (format " ~e" a)) args)))])
(when (test-history-enabled)
(test-history (cons test (test-history))))
(current-run-status (format "running instructor-supplied test ~a"
(format-history test)))
(set-run-status (format "running instructor-supplied test ~a"
(format-history test)))
(let-values ([(ok? val)
(with-handlers ([void
(lambda (x)
@ -175,7 +176,7 @@
(reraise-exn-as-submission-problem
(lambda ()
(let ([e (make-evaluator lang teachpacks program-port)])
(current-run-status "executing your code")
(set-run-status "executing your code")
(go e))))))
(define (call-with-evaluator/submission lang teachpacks str go)