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

fix more test files

Browse Source
This commit is contained in:
Matthew Flatt 2010-05-01 07:23:05 -06:00
parent 77a99f6aa0
commit 043f97df97
15 changed files with 118 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/lang/posn.rkt
View File

@ -1,5 +1,10 @@
#lang racket/base
;; The posn struct for the teaching languages ;; The posn struct for the teaching languages
(module posn mzscheme (provide (struct-out posn) make-posn)
(define-struct posn (x y) (make-inspector)) ; transparent
(provide (struct posn (x y)))) (struct posn (x y) #:mutable #:transparent)
;; We define a separate function so tha it has the
;; name `make-posn':
(define (make-posn x y) (posn x y))

2
collects/lang/private/beginner-funs.rkt
View File

@ -297,7 +297,7 @@
" if so, it produces the suffix of the list that starts with x" " if so, it produces the suffix of the list that starts with x"
" if not, it produces false." " if not, it produces false."
" (it compares values with the eqv? predicate.)") " (it compares values with the eqv? predicate.)")
((beginner-member member?) (any (listof any) -> boolean) ((beginner-member? member?) (any (listof any) -> boolean)
"to determine whether some value is on the list" "to determine whether some value is on the list"
" (comparing values with equal?)") " (comparing values with equal?)")
((beginner-member member) (any (listof any) -> boolean) ((beginner-member member) (any (listof any) -> boolean)

5
collects/lang/private/teach.rkt
View File

@ -757,7 +757,10 @@
(stepper-syntax-property (stepper-syntax-property
#`(define-values (def-proc-name ...) #`(define-values (def-proc-name ...)
(let () (let ()
(define-struct name_ (field_ ...) #:transparent #:constructor-name #,(car proc-names)) (define-struct name_ (field_ ...)
#:transparent
#:mutable
#:constructor-name #,(car proc-names))
(values proc-name ...))) (values proc-name ...)))
'stepper-define-struct-hint 'stepper-define-struct-hint
stx))))]) stx))))])

6
collects/lang/private/teachprims.rkt
View File

@ -163,6 +163,11 @@ namespace.
(check-second 'member a b) (check-second 'member a b)
(not (boolean? (member a b))))) (not (boolean? (member a b)))))
(define-teach beginner member?
(lambda (a b)
(check-second 'member? a b)
(not (boolean? (member a b)))))
(define-teach beginner remove (define-teach beginner remove
(lambda (a b) (lambda (a b)
(check-second 'remove a b) (check-second 'remove a b)
@ -350,6 +355,7 @@ namespace.
beginner-sqr beginner-sqr
beginner-list? beginner-list?
beginner-member beginner-member
beginner-member?
beginner-remove beginner-remove
beginner-cons beginner-cons
beginner-list* beginner-list*

18
collects/tests/racket/advanced.rkt
View File

@ -9,12 +9,12 @@
;; Check export names: ;; Check export names:
(require syntax/docprovide) (require syntax/docprovide)
(let ([docs (lookup-documentation '(lib "htdp-advanced.ss" "lang") 'procedures)]) (let ([docs (lookup-documentation '(lib "htdp-advanced.rkt" "lang") 'procedures)])
(for-each (for-each
(lambda (row) (lambda (row)
(for-each (for-each
(lambda (doc) (lambda (doc)
(let ([v (dynamic-require '(lib "htdp-advanced.ss" "lang") (car doc))]) (let ([v (dynamic-require '(lib "htdp-advanced.rkt" "lang") (car doc))])
(when (and (procedure? v) (when (and (procedure? v)
(not (eq? v call/cc))) (not (eq? v call/cc)))
(test (car doc) object-name v)))) (test (car doc) object-name v))))
@ -22,13 +22,13 @@
docs)) docs))
(define current-htdp-lang 'lang/htdp-advanced) (define current-htdp-lang 'lang/htdp-advanced)
(load-relative "htdp-test.ss") (load-relative "htdp-test.rkt")
(require (lib "htdp-advanced.ss" "lang")) (require (lib "htdp-advanced.rkt" "lang"))
(load-relative "beg-adv.ss") (load-relative "beg-adv.rkt")
(load-relative "bega-adv.ss") (load-relative "bega-adv.rkt")
(load-relative "intm-adv.ss") (load-relative "intm-adv.rkt")
(define (f6 a) (a)) (define (f6 a) (a))
(test (void) f6 void) (test (void) f6 void)
@ -190,7 +190,7 @@
(htdp-test 13 'loop (recur f ([f 13]) f)) (htdp-test 13 'loop (recur f ([f 13]) f))
(htdp-test 14 'loop (let ([f 14]) (recur f ([f f]) f))) (htdp-test 14 'loop (let ([f 14]) (recur f ([f f]) f)))
(load (build-path (collection-path "tests" "mzscheme") "shared-tests.ss")) (load (build-path (collection-path "tests" "racket") "shared-tests.rkt"))
(htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple))) (htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple)))
(htdp-test #t 'equal? (equal? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10 x)]) x))) (htdp-test #t 'equal? (equal? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10 x)]) x)))
@ -209,7 +209,7 @@
(htdp-test #f 'equal~? (equal~? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10.2 x)]) x) 0.1)) (htdp-test #f 'equal~? (equal~? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10.2 x)]) x) 0.1))
;; Simulate set! in the repl ;; Simulate set! in the repl
(module my-advanced-module (lib "htdp-advanced.ss" "lang") (module my-advanced-module (lib "htdp-advanced.rkt" "lang")
(define x 10) (define x 10)
(define (f y) f) (define (f y) f)
(define-struct s (x y))) (define-struct s (x y)))

14
collects/tests/racket/beginner-abbr.rkt
View File

@ -20,14 +20,14 @@
exn:fail:contract?)) exn:fail:contract?))
(define current-htdp-lang 'lang/htdp-beginner-abbr) (define current-htdp-lang 'lang/htdp-beginner-abbr)
(load-relative "htdp-test.ss") (load-relative "htdp-test.rkt")
(require (lib "htdp-beginner-abbr.ss" "lang")) (require (lib "htdp-beginner-abbr.rkt" "lang"))
(load-relative "beg-adv.ss") (load-relative "beg-adv.rkt")
(load-relative "beg-intml.ss") (load-relative "beg-intml.rkt")
(load-relative "beg-intm.ss") (load-relative "beg-intm.rkt")
(load-relative "beg-bega.ss") (load-relative "beg-bega.rkt")
(load-relative "bega-adv.ss") (load-relative "bega-adv.rkt")
(report-errs) (report-errs)

14
collects/tests/racket/beginner.rkt
View File

@ -53,7 +53,7 @@
;; Check that expansion doesn't introduce non-equal ids that ;; Check that expansion doesn't introduce non-equal ids that
;; claim to be "original" at the same place ;; claim to be "original" at the same place
(let loop ([x (expand #'(module m (lib "htdp-beginner.ss" "lang") (let loop ([x (expand #'(module m (lib "htdp-beginner.rkt" "lang")
(define (f x) x)))]) (define (f x) x)))])
(let ([orig-ids (let loop ([x x]) (let ([orig-ids (let loop ([x x])
(cond (cond
@ -82,14 +82,14 @@
(require (only-in mzscheme exn:fail? exn:fail:contract?)) (require (only-in mzscheme exn:fail? exn:fail:contract?))
(define current-htdp-lang 'lang/htdp-beginner) (define current-htdp-lang 'lang/htdp-beginner)
(load-relative "htdp-test.ss") (load-relative "htdp-test.rkt")
(require (lib "htdp-beginner.ss" "lang")) (require (lib "htdp-beginner.rkt" "lang"))
(load-relative "beg-adv.ss") (load-relative "beg-adv.rkt")
(load-relative "beg-intml.ss") (load-relative "beg-intml.rkt")
(load-relative "beg-intm.ss") (load-relative "beg-intm.rkt")
(load-relative "beg-bega.ss") (load-relative "beg-bega.rkt")
(htdp-syntax-test #'quote) (htdp-syntax-test #'quote)
(htdp-syntax-test #''1) (htdp-syntax-test #''1)

6
collects/tests/racket/benchmarks/rx/auto.rkt
View File

@ -1,6 +1,6 @@
#!/bin/sh #!/bin/sh
#| #|
exec mzscheme -qu "$0" ${1+"$@"} exec racket -qu "$0" ${1+"$@"}
|# |#
(module auto mzscheme (module auto mzscheme
@ -23,7 +23,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(loop (sub1 n)))) (loop (sub1 n))))
(- (current-inexact-milliseconds) start))) (- (current-inexact-milliseconds) start)))
(define (test-mzscheme input rx iterations) (define (test-racket input rx iterations)
(test-mz input (byte-pregexp rx) iterations)) (test-mz input (byte-pregexp rx) iterations))
(define (test-mzunicode input rx iterations) (define (test-mzunicode input rx iterations)
@ -272,7 +272,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(define benchmark-names (map car inputs)) (define benchmark-names (map car inputs))
(define testers (define testers
(list (list 'mzscheme test-mzscheme) (list (list 'racket test-racket)
(list 'perl test-perl) (list 'perl test-perl)
(list 'python test-python) (list 'python test-python)
(list 'pcre test-pcre) (list 'pcre test-pcre)

80
collects/tests/racket/benchmarks/shootout/run.rkt
View File

@ -2,45 +2,45 @@
(require (only scheme/runtime-path define-runtime-path)) (require (only scheme/runtime-path define-runtime-path))
(define input-map (define input-map
`( `(
("ackermann.ss" "11") ("ackermann.rkt" "11")
("ary.ss" "9000") ("ary.rkt" "9000")
("binarytrees.ss" "16") ("binarytrees.rkt" "16")
("chameneos.ss" "1000000") ("chameneos.rkt" "1000000")
("cheapconcurrency.ss" "15000") ("cheapconcurrency.rkt" "15000")
("echo.ss" "150000") ("echo.rkt" "150000")
("except.ss" "2500000") ("except.rkt" "2500000")
("fannkuch.ss" "10") ("fannkuch.rkt" "10")
("fasta.ss" "25000000") ("fasta.rkt" "25000000")
("fibo.ss" "32") ("fibo.rkt" "32")
("hash.ss" "100000") ("hash.rkt" "100000")
("hash2.ss" "200") ("hash2.rkt" "200")
("heapsort.ss" "100000") ("heapsort.rkt" "100000")
("lists.ss" "18") ("lists.rkt" "18")
("mandelbrot.ss" "3000") ("mandelbrot.rkt" "3000")
("matrix.ss" "600") ("matrix.rkt" "600")
("moments.ss") ; 200 somethings... ("moments.rkt") ; 200 somethings...
("nbody.ss" "20000000") ("nbody.rkt" "20000000")
("nestedloop.ss" "18") ("nestedloop.rkt" "18")
("nsieve.ss" "9") ("nsieve.rkt" "9")
("nsievebits.ss" "11") ("nsievebits.rkt" "11")
("partialsums.ss" "2500000") ("partialsums.rkt" "2500000")
("pidigits.ss" "2500") ("pidigits.rkt" "2500")
("pidigits1.ss") ("pidigits1.rkt")
("random.ss" "900000") ("random.rkt" "900000")
("recursive.ss" "11") ("recursive.rkt" "11")
("regexmatch.ss") ("regexmatch.rkt")
("regexpdna.ss" #f ,(lambda () (mk-regexpdna-input))) ("regexpdna.rkt" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement.ss" #f ,(lambda () (mk-revcomp-input))) ("reversecomplement.rkt" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide.ss" #f ,(lambda () (mk-knuc-input))) ("k-nucleotide.rkt" #f ,(lambda () (mk-knuc-input)))
("reversefile.ss") ("reversefile.rkt")
("sieve.ss" "1200") ("sieve.rkt" "1200")
("spellcheck.ss") ("spellcheck.rkt")
("spectralnorm.ss" "5500") ("spectralnorm.rkt" "5500")
("spectralnorm-unsafe.ss" "5500") ("spectralnorm-unsafe.rkt" "5500")
("strcat.ss" "40000") ("strcat.rkt" "40000")
("sumcol.ss" #f ,(lambda () (mk-sumcol-input))) ("sumcol.rkt" #f ,(lambda () (mk-sumcol-input)))
("wc.ss") ("wc.rkt")
("wordfreq.ss") ("wordfreq.rkt")
)) ))
(define-runtime-path here ".") (define-runtime-path here ".")
@ -56,7 +56,7 @@
(with-output-to-file f (with-output-to-file f
(lambda () (lambda ()
(parameterize ([current-command-line-arguments (vector n)]) (parameterize ([current-command-line-arguments (vector n)])
(dynreq "fasta.ss"))))) (dynreq "fasta.rkt")))))
f)) f))
(define (mk-revcomp-input) (define (mk-revcomp-input)

11
collects/tests/racket/embed-in-c.rkt
View File

@ -1,5 +1,6 @@
;; Works for Linux, Mac OS X. ;; Works for Linux.
;; Assumes 3m ;; Almost works for Mac OS X.
;; Assumes 3m.
(load-relative "loadtest.rkt") (load-relative "loadtest.rkt")
@ -8,7 +9,7 @@
(require scheme/system (require scheme/system
setup/dirs) setup/dirs)
(define dir (collection-path "tests" "mzscheme")) (define dir (collection-path "tests" "racket"))
(define lib-dir (find-lib-dir)) (define lib-dir (find-lib-dir))
(parameterize ([current-directory dir]) (parameterize ([current-directory dir])
@ -19,9 +20,9 @@
(test #t system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a" (test #t system (format "cc -o embed-in-c embed-in-c.o -lm -ldl -pthread ~a"
(case (system-type 'link) (case (system-type 'link)
[(framework) [(framework)
(format "-F\"~a\" -framework PLT_MzScheme" lib-dir)] (format "-F\"~a\" -framework Racket" lib-dir)]
[(static shared) [(static shared)
(format "-L\"~a\" -lmzscheme3m" lib-dir)] (format "-L\"~a\" -lracket3m" lib-dir)]
[else [else
(error "unsupported")]))) (error "unsupported")])))

20
collects/tests/racket/intermediate-lambda.rkt
View File

@ -1,6 +1,6 @@
;; Basic checks for the intermediate language. See also ;; Basic checks for the intermediate language. See also
;; beginner.ss ;; beginner.rkt
(load-relative "loadtest.rkt") (load-relative "loadtest.rkt")
@ -9,26 +9,26 @@
;; Check export names: ;; Check export names:
(require syntax/docprovide) (require syntax/docprovide)
(let ([docs (lookup-documentation '(lib "htdp-intermediate-lambda.ss" "lang") 'procedures)]) (let ([docs (lookup-documentation '(lib "htdp-intermediate-lambda.rkt" "lang") 'procedures)])
(for-each (for-each
(lambda (row) (lambda (row)
(for-each (for-each
(lambda (doc) (lambda (doc)
(let ([v (dynamic-require '(lib "htdp-intermediate-lambda.ss" "lang") (car doc))]) (let ([v (dynamic-require '(lib "htdp-intermediate-lambda.rkt" "lang") (car doc))])
(when (procedure? v) (when (procedure? v)
(test (car doc) object-name v)))) (test (car doc) object-name v))))
(cdr row))) (cdr row)))
docs)) docs))
(define current-htdp-lang 'lang/htdp-intermediate-lambda) (define current-htdp-lang 'lang/htdp-intermediate-lambda)
(load-relative "htdp-test.ss") (load-relative "htdp-test.rkt")
(require (lib "htdp-intermediate-lambda.ss" "lang")) (require (lib "htdp-intermediate-lambda.rkt" "lang"))
(load-relative "beg-adv.ss") (load-relative "beg-adv.rkt")
(load-relative "beg-intml.ss") (load-relative "beg-intml.rkt")
(load-relative "bega-adv.ss") (load-relative "bega-adv.rkt")
(load-relative "intm-intml.ss") (load-relative "intm-intml.rkt")
(load-relative "intm-adv.ss") (load-relative "intm-adv.rkt")
(report-errs) (report-errs)

22
collects/tests/racket/intermediate.rkt
View File

@ -1,6 +1,6 @@
;; Basic checks for the intermediate language. See also ;; Basic checks for the intermediate language. See also
;; beginner.ss ;; beginner.rkt
(load-relative "loadtest.rkt") (load-relative "loadtest.rkt")
@ -9,27 +9,27 @@
;; Check export names: ;; Check export names:
(require syntax/docprovide) (require syntax/docprovide)
(let ([docs (lookup-documentation '(lib "htdp-intermediate.ss" "lang") 'procedures)]) (let ([docs (lookup-documentation '(lib "htdp-intermediate.rkt" "lang") 'procedures)])
(for-each (for-each
(lambda (row) (lambda (row)
(for-each (for-each
(lambda (doc) (lambda (doc)
(let ([v (dynamic-require '(lib "htdp-intermediate.ss" "lang") (car doc))]) (let ([v (dynamic-require '(lib "htdp-intermediate.rkt" "lang") (car doc))])
(when (procedure? v) (when (procedure? v)
(test (car doc) object-name v)))) (test (car doc) object-name v))))
(cdr row))) (cdr row)))
docs)) docs))
(define current-htdp-lang 'lang/htdp-intermediate) (define current-htdp-lang 'lang/htdp-intermediate)
(load-relative "htdp-test.ss") (load-relative "htdp-test.rkt")
(require (lib "htdp-intermediate.ss" "lang")) (require (lib "htdp-intermediate.rkt" "lang"))
(load-relative "beg-adv.ss") (load-relative "beg-adv.rkt")
(load-relative "beg-intml.ss") (load-relative "beg-intml.rkt")
(load-relative "beg-intm.ss") (load-relative "beg-intm.rkt")
(load-relative "bega-adv.ss") (load-relative "bega-adv.rkt")
(load-relative "intm-intml.ss") (load-relative "intm-intml.rkt")
(load-relative "intm-adv.ss") (load-relative "intm-adv.rkt")
(report-errs) (report-errs)

2
collects/tests/racket/ttt/tic-bang.rkt
View File

@ -11,7 +11,7 @@
;; It relies on list-library.ss. ;; It relies on list-library.ss.
(load-relative "listlib.ss") (load-relative "listlib.rkt")
;; representations of fields, states, and collections of states ;; representations of fields, states, and collections of states
(define BLANK 0) (define BLANK 0)

4
collects/tests/racket/ttt/tic-func.rkt
View File

@ -6,9 +6,9 @@
;; each stage of the game. But it is constructed so that it can ;; each stage of the game. But it is constructed so that it can
;; print how to get to a winning terminal state. ;; print how to get to a winning terminal state.
;; It relies on list-library.ss. ;; It relies on list-library.rkt.
(load-relative "listlib.ss") (load-relative "listlib.rkt")
;; representations of fields, states, and collections of states ;; representations of fields, states, and collections of states
(define null '()) (define null '())

6
collects/tests/racket/ttt/ttt.rkt
View File

@ -1,8 +1,8 @@
(require mzlib/etc mzlib/compat) (require mzlib/etc mzlib/compat)
(load-relative "listlib.ss") (load-relative "listlib.rkt")
(load-relative "veclib.ss") (load-relative "veclib.rkt")
(load-relative "tic-func.ss") (load-relative "tic-func.rkt")
(let loop () (let loop ()
(collect-garbage) (collect-garbage)