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

* Added (module <lang>) as a specification for using

Browse Source 
`make-module-evaluator' accepting only modules with the specified
  language.
* Fix a bug with deciding on how to convert values for printing.
* Improved code in checker.ss.

svn: r11955
This commit is contained in:
Eli Barzilay 2008-10-06 21:44:23 +00:00
parent 433819df52
commit d2bd4c050e
3 changed files with 37 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -488,6 +488,14 @@
submission->bytes)
submission maxwidth textualize? untabify?
markup-prefix prefix-re))))
(define (uem-handler e)
(let ([m (if (exn? e) (exn-message e) (format "~a" e))])
(cond
[(procedure? uem) (uem m)]
[(not (string? uem))
(error* "badly configured user-error-message")]
[(regexp-match? #rx"~[aesvAESV]" uem) (error* uem m)]
[else (error* "~a" uem)])))
(when create-text? (make-directory "grading") (write-text))
(when value-printer (current-value-printer value-printer))
(when coverage? (sandbox-coverage-enabled #t))
@ -495,24 +503,10 @@
(cond
[(not eval?) (let () body ...)]
[language
(let ([eval
(with-handlers
([void
(lambda (e)
(let ([m (if (exn? e)
(exn-message e)
(format "~a" e))])
(cond
[(procedure? uem) (uem m)]
[(not (string? uem))
(error* "badly configured ~a"
"user-error-message")]
[(regexp-match? #rx"~[aesvAESV]" uem)
(error* uem m)]
[else (error* "~a" uem)])))])
(call-with-evaluator/submission
language (append requires teachpacks)
submission values))])
(let ([eval (with-handlers ([void uem-handler])
(call-with-evaluator/submission
language (append requires teachpacks)
submission values))])
(set-run-status "running tests")
(parameterize ([submission-eval (wrap-evaluator eval)])
(let-syntax ([with-submission-bindings

18
collects/handin-server/scribblings/utils.scrbl
View File

@ -21,6 +21,7 @@
@defproc[(make-evaluator/submission
[language (or/c module-path?
(list/c (one-of/c 'special) symbol?)
(list/c (one-of/c 'module) module-path?)
(cons/c (one-of/c 'begin) list?))]
[require-paths (listof path-string?)]
[content bytes?])
@ -28,11 +29,19 @@
Like @scheme[make-evaluator], but the definitions content is
supplied as a submission byte string. The byte string is opened for
reading, with line-counting enabled.}
reading, with line-counting enabled.
In addition to the language specification for
@scheme[make-evaluator], the @scheme[language] argument can be a
list that begins with @scheme['module]. In this case,
@scheme[make-module-language] is used to create an evaluator, and
the module code must be using the the specified language in its
language position.}
@defproc[(call-with-evaluator
[language (or/c module-path?
(list/c (one-of/c 'special) symbol?)
(list/c (one-of/c 'module) module-path?)
(cons/c (one-of/c 'begin) list?))]
[require-paths (listof path-string?)]
[input-program any/c]
@ -46,11 +55,13 @@
suitable for @scheme[language], it initializes
@scheme[set-run-status] with @scheme["executing your code"], and it
catches all exceptions to re-raise them in a form suitable as a
submission error.}
submission error. See @scheme[make-evaluator/submission] for
further details.}
@defproc[(call-with-evaluator/submission [language
(or/c module-path?
(list/c (one-of/c 'special) symbol?)
(list/c (one-of/c 'module) module-path?)
(cons/c (one-of/c 'begin) list?))]
[require-paths (listof path-string?)]
[submission bytes?]
@ -59,7 +70,8 @@
Like @scheme[call-with-evaluator], but the definitions content is
supplied as a byte string. The byte string is opened for reading,
with line-counting enabled.}
with line-counting enabled. See @scheme[call-with-evaluator] and
@scheme[make-evaluator/submission] for further details.}
@; JBC: this contract is probably wrong
@; JBC: does this eval accept an optional namespace?

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

@ -48,14 +48,18 @@
;; Execution ----------------------------------------
(define (make-evaluator* lang reqs inp)
(if (and (list? lang) (= 2 (length lang)) (eq? 'module (car lang)))
(make-module-evaluator inp #:language (cadr lang) #:allow-read reqs)
(make-evaluator lang inp #:requires reqs)))
(define (open-input-text-editor/lines str)
(let ([inp (open-input-text-editor str)])
(port-count-lines! inp) inp))
(define (make-evaluator/submission language requires str)
(let-values ([(defs interacts) (unpack-submission str)])
(make-evaluator language #:requires requires
(open-input-text-editor defs))))
(make-evaluator* language requires (open-input-text-editor defs))))
(define (evaluate-all source port eval)
(let loop ()
@ -164,11 +168,12 @@
(define (call-with-evaluator lang requires program-port go)
(parameterize ([error-value->string-handler (lambda (v s)
((current-value-printer) v))]
[list-abbreviation-enabled (not (or (eq? lang 'beginner)
(eq? lang 'beginner-abbr)))])
[list-abbreviation-enabled
(not (or (equal? lang '(special beginner))
(equal? lang '(special beginner-abbr))))])
(reraise-exn-as-submission-problem
(lambda ()
(let ([e (make-evaluator lang #:requires requires program-port)])
(let ([e (make-evaluator* lang requires program-port)])
(set-run-status "executing your code")
(go e))))))