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.
|
||||
|
||||
> (evaluate-submission bytes eval)
|
||||
Like `load' on a non-test-suite submission byte string.
|
||||
Like `load' on a submission byte string.
|
||||
|
||||
> coverage-enabled
|
||||
Parameter that controls whether coverage testing is enabled. If it
|
||||
|
|
|
@ -11,9 +11,6 @@
|
|||
|
||||
(provide unpack-submission
|
||||
|
||||
unpack-test-suite-submission
|
||||
is-test-suite-submission?
|
||||
|
||||
make-evaluator
|
||||
make-evaluator/submission
|
||||
evaluate-all
|
||||
|
@ -48,96 +45,6 @@
|
|||
(read-editor-global-footer stream)
|
||||
(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 ---------------------------------------
|
||||
|
||||
(define ok-path-re
|
||||
|
|
Loading…
Reference in New Issue
Block a user