removed test-suite related code

svn: r5302
This commit is contained in:
Eli Barzilay 2007-01-10 17:47:13 +00:00
parent 76773d289e
commit 9e78a08d6e
2 changed files with 1 additions and 94 deletions

View File

@ -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

View File

@ -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