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

svn: r11682

Browse Source
This commit is contained in:
Eli Barzilay 2008-09-12 15:23:05 +00:00
parent 5675f4574c
commit 78632e178d
1 changed files with 22 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,11 +1,7 @@
#lang scheme/base #lang scheme/base
(require scheme/list (require scheme/class mred lang/posn scheme/pretty
scheme/class
mred
lang/posn
(prefix-in pc: mzlib/pconvert) (prefix-in pc: mzlib/pconvert)
scheme/pretty
(only-in "main.ss" timeout-control) (only-in "main.ss" timeout-control)
"private/run-status.ss" "private/run-status.ss"
"private/config.ss" "private/config.ss"
@ -76,8 +72,8 @@
(define (reraise-exn-as-submission-problem thunk) (define (reraise-exn-as-submission-problem thunk)
(with-handlers ([void (lambda (exn) (with-handlers ([void (lambda (exn)
(error (if (exn? exn) (error (if (exn? exn)
(exn-message exn) (exn-message exn)
(format "exception: ~e" exn))))]) (format "exception: ~e" exn))))])
(thunk))) (thunk)))
;; ---------------------------------------- ;; ----------------------------------------
@ -98,10 +94,10 @@
(define (format-history one-test) (define (format-history one-test)
(if (test-history-enabled) (if (test-history-enabled)
(format "(begin~a)" (format "(begin~a)"
(apply string-append (map (lambda (s) (format " ~a" s)) (apply string-append (map (lambda (s) (format " ~a" s))
(reverse (test-history))))) (reverse (test-history)))))
one-test)) one-test))
(define (check-proc e result equal? f . args) (define (check-proc e result equal? f . args)
(let ([test (format "(~a~a)" f (let ([test (format "(~a~a)" f
@ -125,9 +121,7 @@
(unless ok? (unless ok?
(error (error
(format "instructor-supplied test ~a should have produced ~e, instead produced ~e" (format "instructor-supplied test ~a should have produced ~e, instead produced ~e"
(format-history test) (format-history test) result val)))
result
val)))
val))) val)))
(define (user-construct e func . args) (define (user-construct e func . args)
@ -138,18 +132,14 @@
(let loop ([found 0]) (let loop ([found 0])
(let ([e (read p)]) (let ([e (read p)])
(if (eof-object? e) (if (eof-object? e)
(when (found . < . count) (when (found . < . count)
(error (format "found ~a test~a for ~a, need at least ~a test~a" (error (format "found ~a test~a for ~a, need at least ~a test~a"
found found
(if (= found 1) "" "s") (if (= found 1) "" "s")
name name
count count
(if (= count 1) "" "s")))) (if (= count 1) "" "s"))))
(loop (+ found (loop (+ found (if (and (pair? e) (eq? (car e) name)) 1 0))))))))
(if (and (pair? e)
(eq? (car e) name))
1
0))))))))
(define list-abbreviation-enabled (make-parameter #f)) (define list-abbreviation-enabled (make-parameter #f))