removed test-suite related code
svn: r5302
This commit is contained in:
parent
76773d289e
commit
9e78a08d6e
|
@ -596,7 +596,7 @@ The _utils.ss_ module provides utilities helpful in implementing
|
||||||
Like `load' on an input port.
|
Like `load' on an input port.
|
||||||
|
|
||||||
> (evaluate-submission bytes eval)
|
> (evaluate-submission bytes eval)
|
||||||
Like `load' on a non-test-suite submission byte string.
|
Like `load' on a submission byte string.
|
||||||
|
|
||||||
> coverage-enabled
|
> coverage-enabled
|
||||||
Parameter that controls whether coverage testing is enabled. If it
|
Parameter that controls whether coverage testing is enabled. If it
|
||||||
|
|
|
@ -11,9 +11,6 @@
|
||||||
|
|
||||||
(provide unpack-submission
|
(provide unpack-submission
|
||||||
|
|
||||||
unpack-test-suite-submission
|
|
||||||
is-test-suite-submission?
|
|
||||||
|
|
||||||
make-evaluator
|
make-evaluator
|
||||||
make-evaluator/submission
|
make-evaluator/submission
|
||||||
evaluate-all
|
evaluate-all
|
||||||
|
@ -48,96 +45,6 @@
|
||||||
(read-editor-global-footer stream)
|
(read-editor-global-footer stream)
|
||||||
(values definitions-text interactions-text)))
|
(values definitions-text interactions-text)))
|
||||||
|
|
||||||
(define (unpack-test-suite-submission str)
|
|
||||||
(let* ([base (make-object editor-stream-in-bytes-base% str)]
|
|
||||||
[stream (make-object editor-stream-in% base)]
|
|
||||||
[ts (make-object ts-load%)])
|
|
||||||
(read-editor-version stream base #t)
|
|
||||||
(read-editor-global-header stream)
|
|
||||||
(send ts read-from-file stream)
|
|
||||||
(read-editor-global-footer stream)
|
|
||||||
ts))
|
|
||||||
|
|
||||||
(define (is-test-suite-submission? str)
|
|
||||||
(send (unpack-test-suite-submission str)
|
|
||||||
got-program?))
|
|
||||||
|
|
||||||
;; Test Suite Unpacking ----------------------------------------
|
|
||||||
;; This code duplicates just enough of the test-suite snips
|
|
||||||
;; to make test-suite files readable.
|
|
||||||
|
|
||||||
(define program-header-field-name "drscheme:test-suite:program")
|
|
||||||
|
|
||||||
(define csc (new
|
|
||||||
(class snip-class%
|
|
||||||
(define/override (read f)
|
|
||||||
(let ([case (new case%)])
|
|
||||||
(send case read-from-file f)
|
|
||||||
case))
|
|
||||||
(super-new))))
|
|
||||||
(send csc set-classname "case%")
|
|
||||||
(send csc set-version 1)
|
|
||||||
(send (get-the-snip-class-list) add csc)
|
|
||||||
|
|
||||||
(define case%
|
|
||||||
(class editor-snip%
|
|
||||||
(inherit set-snipclass get-editor)
|
|
||||||
|
|
||||||
(define call (new text%))
|
|
||||||
(define expected (new text%))
|
|
||||||
(define test (new text%))
|
|
||||||
|
|
||||||
(define/public (read-from-file f)
|
|
||||||
(send call read-from-file f)
|
|
||||||
(send expected read-from-file f)
|
|
||||||
(send test read-from-file f)
|
|
||||||
(send f get-string))
|
|
||||||
|
|
||||||
(super-new)
|
|
||||||
|
|
||||||
(set-snipclass csc)
|
|
||||||
(send (get-editor) insert (make-object editor-snip% call))
|
|
||||||
(send (get-editor) insert (make-object editor-snip% expected))
|
|
||||||
(send (get-editor) insert (make-object editor-snip% test))))
|
|
||||||
|
|
||||||
(define dsc (new
|
|
||||||
(class snip-class%
|
|
||||||
(define/override (read f)
|
|
||||||
(let ([helper (new helper%)])
|
|
||||||
(send helper read-from-file f)
|
|
||||||
helper))
|
|
||||||
(super-new))))
|
|
||||||
(send dsc set-classname "drscheme:test-suite:helper%")
|
|
||||||
(send dsc set-version 1)
|
|
||||||
(send (get-the-snip-class-list) add dsc)
|
|
||||||
|
|
||||||
(define helper%
|
|
||||||
(class editor-snip%
|
|
||||||
(inherit set-snipclass get-editor)
|
|
||||||
|
|
||||||
(define/public (read-from-file f)
|
|
||||||
(send (get-editor) read-from-file f))
|
|
||||||
|
|
||||||
(super-new)
|
|
||||||
|
|
||||||
(set-snipclass dsc)))
|
|
||||||
|
|
||||||
(define ts-load%
|
|
||||||
(class pasteboard%
|
|
||||||
(define program (new text%))
|
|
||||||
|
|
||||||
(define got-p? #f)
|
|
||||||
(define/public (got-program?) got-p?)
|
|
||||||
|
|
||||||
(define/override (read-header-from-file stream name)
|
|
||||||
(if (string=? name program-header-field-name)
|
|
||||||
(begin
|
|
||||||
(set! got-p? #t)
|
|
||||||
(send program read-from-file stream))
|
|
||||||
(super read-header-from-file stream name)))
|
|
||||||
|
|
||||||
(super-new)))
|
|
||||||
|
|
||||||
;; Protection ---------------------------------------
|
;; Protection ---------------------------------------
|
||||||
|
|
||||||
(define ok-path-re
|
(define ok-path-re
|
||||||
|
|
Loading…
Reference in New Issue
Block a user