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

* Added functionality for checking coverage information

Browse Source 
* Submissions are opened with line counting

svn: r853
This commit is contained in:
Eli Barzilay 2005-09-14 18:23:05 +00:00
parent 02c6c62601
commit b28a6df99b
2 changed files with 58 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -416,7 +416,7 @@ The _utils.ss_ module provides utilities helpful in implementing
to the submitted definitions and interactions windows.
> (make-evaluator language teachpack-paths program-port) - returns a
function of one argument for evaluating expressions in the
function of one required argument for evaluating expressions in the
designated language, and loading teachpacks that are specified in
`teachpack-paths'. The `program-port' is an input port that
produces the content of the definitions window; use
@ -443,9 +443,14 @@ The _utils.ss_ module provides utilities helpful in implementing
security guard that reading files only from PLT collections, and no
other operations.
Additional arguments to the evaluator function are special messages
that retrieve additional information. Currently, only
'execute-counts is used (see below).
> (make-evaluator/submission language teachpack-paths bytes) - like
`make-evaluator', but the definitions content is supplied as a
submission byte string.
submission byte string. The byte string is opened for reading, with
line-counting enabled.
> (call-with-evaluator language teachpack-paths program-port proc) -
calls `proc' with an evaluator for the given language, teachpack
@ -456,8 +461,9 @@ The _utils.ss_ module provides utilities helpful in implementing
them in a form suitable as a submission error.
> (call-with-evaluator/submission language teachpack-paths bytes proc) -
like `call-with-evaluator', but the definitions content is supplied
as a submission string.
like `call-with-evaluator', but the definitions content is supplied
as a submission string. The byte string is opened for reading,
with line-counting enabled.
> (evaluate-all source input-port eval) - like `load' on an input
@ -467,6 +473,17 @@ The _utils.ss_ module provides utilities helpful in implementing
submission byte string.
> coverage-enabled - parameter that controls whether coverage testing is
enabled. If it set to true, the errortrace collection will be used
to collect coverage information during evaluation of the submission,
this information is collected before additional checker-evaluations.
To retrieve the collected information, apply the evaluation function
with a second argument of 'execute-counts (the first argument will
be ignored). The resulting value is the same as the result of
errortrace's `get-execute-counts', with all non-submission entries
filtered out.
> (check-proc eval expect-v compare-proc proc-name arg ...) - calls
the function named `proc-name' using the evaluator `eval', giving it
the (unquoted) arguments `arg'... Let `result-v' be the result of

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

@ -24,6 +24,8 @@
current-run-status
current-value-printer
coverage-enabled
check-proc
check-defined
look-for-tests
@ -162,8 +164,12 @@
;; Execution ----------------------------------------
(define coverage-enabled (make-parameter #f))
(define (make-evaluator language teachpacks program-port)
(let ([ns (make-namespace-with-mred)]
(let ([coverage-enabled (coverage-enabled)]
[execute-counts #f]
[ns (make-namespace-with-mred)]
[orig-ns (current-namespace)]
[posn-module ((current-module-name-resolver) '(lib "posn.ss" "lang") #f #f)])
(parameterize ([current-namespace ns]
@ -221,7 +227,16 @@
[else (error 'make-evaluator
"Bad language specification: ~e"
language)])])
(when coverage-enabled
(for-each safe-eval
'((require (lib "errortrace.ss" "errortrace"))
(execute-counts-enabled #t))))
(safe-eval body)
(when coverage-enabled
(set! execute-counts
(filter (lambda (x)
(eq? 'program (syntax-source (car x))))
(safe-eval '(get-execute-counts)))))
(when (and (pair? body) (eq? 'module (car body))
(pair? (cdr body)) (symbol? (cadr body)))
(let ([mod (cadr body)])
@ -242,18 +257,28 @@
(let ([r (channel-get result-ch)])
(if (eq? r 'ok)
;; Initial program executed ok, so return an evaluator:
(lambda (expr)
(channel-put ch expr)
(let ([r (channel-get result-ch)])
(if (eq? (car r) 'exn)
(raise (cdr r))
(cdr r))))
(lambda (expr . more)
(if (pair? more)
(case (car more)
[(execute-counts) execute-counts]
[else (error 'make-evaluator
"Bad arguments: ~e"
(cons expr more))])
(begin (channel-put ch expr)
(let ([r (channel-get result-ch)])
(if (eq? (car r) 'exn)
(raise (cdr r))
(cdr r))))))
;; Program didn't execute:
(raise (cdr r)))))))))
(define (open-input-text-editor/lines str)
(let ([inp (open-input-text-editor str)])
(port-count-lines! inp) inp))
(define (make-evaluator/submission language teachpacks str)
(let-values ([(defs interacts) (unpack-submission str)])
(make-evaluator language teachpacks (open-input-text-editor defs))))
(make-evaluator language teachpacks (open-input-text-editor/lines defs))))
(define (evaluate-all source port eval)
(let loop ()
@ -266,7 +291,7 @@
(define (evaluate-submission str eval)
(let-values ([(defs interacts) (unpack-submission str)])
(evaluate-all 'handin (open-input-text-editor defs) eval)))
(evaluate-all 'handin (open-input-text-editor/lines defs) eval)))
(define (reraise-exn-as-submission-problem thunk)
(with-handlers ([void (lambda (exn)
@ -336,7 +361,7 @@
(apply check-proc e func 'anything eq? args))
(define (look-for-tests t name count)
(let ([p (open-input-text-editor t)])
(let ([p (open-input-text-editor/lines t)])
(let loop ([found 0])
(let ([e (read p)])
(if (eof-object? e)
@ -385,6 +410,6 @@
(define (call-with-evaluator/submission lang teachpacks str go)
(let-values ([(defs interacts) (unpack-submission str)])
(call-with-evaluator lang teachpacks (open-input-text-editor defs) go)))
(call-with-evaluator lang teachpacks (open-input-text-editor/lines defs) go)))
)