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
(module posn mzscheme
(define-struct posn (x y) (make-inspector)) ; transparent
(provide (struct posn (x y))))
(provide (struct-out posn) make-posn)
(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 not, it produces false."
" (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"
" (comparing values with equal?)")
((beginner-member member) (any (listof any) -> boolean)

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

@ -757,7 +757,10 @@
(stepper-syntax-property
#`(define-values (def-proc-name ...)
(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 ...)))
'stepper-define-struct-hint
stx))))])

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

@ -163,6 +163,11 @@ namespace.
(check-second '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
(lambda (a b)
(check-second 'remove a b)
@ -350,6 +355,7 @@ namespace.
beginner-sqr
beginner-list?
beginner-member
beginner-member?
beginner-remove
beginner-cons
beginner-list*

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

@ -9,12 +9,12 @@
;; Check export names:
(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
(lambda (row)
(for-each
(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)
(not (eq? v call/cc)))
(test (car doc) object-name v))))
@ -22,13 +22,13 @@
docs))
(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 "bega-adv.ss")
(load-relative "intm-adv.ss")
(load-relative "beg-adv.rkt")
(load-relative "bega-adv.rkt")
(load-relative "intm-adv.rkt")
(define (f6 a) (a))
(test (void) f6 void)
@ -190,7 +190,7 @@
(htdp-test 13 'loop (recur f ([f 13]) 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? (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))
;; 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 (f y) f)
(define-struct s (x y)))

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

@ -20,14 +20,14 @@
exn:fail:contract?))
(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-intml.ss")
(load-relative "beg-intm.ss")
(load-relative "beg-bega.ss")
(load-relative "bega-adv.ss")
(load-relative "beg-adv.rkt")
(load-relative "beg-intml.rkt")
(load-relative "beg-intm.rkt")
(load-relative "beg-bega.rkt")
(load-relative "bega-adv.rkt")
(report-errs)

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

@ -53,7 +53,7 @@
;; Check that expansion doesn't introduce non-equal ids that
;; 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)))])
(let ([orig-ids (let loop ([x x])
(cond
@ -82,14 +82,14 @@
(require (only-in mzscheme exn:fail? exn:fail:contract?))
(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-intml.ss")
(load-relative "beg-intm.ss")
(load-relative "beg-bega.ss")
(load-relative "beg-adv.rkt")
(load-relative "beg-intml.rkt")
(load-relative "beg-intm.rkt")
(load-relative "beg-bega.rkt")
(htdp-syntax-test #'quote)
(htdp-syntax-test #''1)

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

@ -1,6 +1,6 @@
#!/bin/sh
#|
exec mzscheme -qu "$0" ${1+"$@"}
exec racket -qu "$0" ${1+"$@"}
|#
(module auto mzscheme
@ -23,7 +23,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(loop (sub1 n))))
(- (current-inexact-milliseconds) start)))
(define (test-mzscheme input rx iterations)
(define (test-racket input rx iterations)
(test-mz input (byte-pregexp rx) iterations))
(define (test-mzunicode input rx iterations)
@ -272,7 +272,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
(define benchmark-names (map car inputs))
(define testers
(list (list 'mzscheme test-mzscheme)
(list (list 'racket test-racket)
(list 'perl test-perl)
(list 'python test-python)
(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))
(define input-map
`(
("ackermann.ss" "11")
("ary.ss" "9000")
("binarytrees.ss" "16")
("chameneos.ss" "1000000")
("cheapconcurrency.ss" "15000")
("echo.ss" "150000")
("except.ss" "2500000")
("fannkuch.ss" "10")
("fasta.ss" "25000000")
("fibo.ss" "32")
("hash.ss" "100000")
("hash2.ss" "200")
("heapsort.ss" "100000")
("lists.ss" "18")
("mandelbrot.ss" "3000")
("matrix.ss" "600")
("moments.ss") ; 200 somethings...
("nbody.ss" "20000000")
("nestedloop.ss" "18")
("nsieve.ss" "9")
("nsievebits.ss" "11")
("partialsums.ss" "2500000")
("pidigits.ss" "2500")
("pidigits1.ss")
("random.ss" "900000")
("recursive.ss" "11")
("regexmatch.ss")
("regexpdna.ss" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement.ss" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide.ss" #f ,(lambda () (mk-knuc-input)))
("reversefile.ss")
("sieve.ss" "1200")
("spellcheck.ss")
("spectralnorm.ss" "5500")
("spectralnorm-unsafe.ss" "5500")
("strcat.ss" "40000")
("sumcol.ss" #f ,(lambda () (mk-sumcol-input)))
("wc.ss")
("wordfreq.ss")
("ackermann.rkt" "11")
("ary.rkt" "9000")
("binarytrees.rkt" "16")
("chameneos.rkt" "1000000")
("cheapconcurrency.rkt" "15000")
("echo.rkt" "150000")
("except.rkt" "2500000")
("fannkuch.rkt" "10")
("fasta.rkt" "25000000")
("fibo.rkt" "32")
("hash.rkt" "100000")
("hash2.rkt" "200")
("heapsort.rkt" "100000")
("lists.rkt" "18")
("mandelbrot.rkt" "3000")
("matrix.rkt" "600")
("moments.rkt") ; 200 somethings...
("nbody.rkt" "20000000")
("nestedloop.rkt" "18")
("nsieve.rkt" "9")
("nsievebits.rkt" "11")
("partialsums.rkt" "2500000")
("pidigits.rkt" "2500")
("pidigits1.rkt")
("random.rkt" "900000")
("recursive.rkt" "11")
("regexmatch.rkt")
("regexpdna.rkt" #f ,(lambda () (mk-regexpdna-input)))
("reversecomplement.rkt" #f ,(lambda () (mk-revcomp-input)))
("k-nucleotide.rkt" #f ,(lambda () (mk-knuc-input)))
("reversefile.rkt")
("sieve.rkt" "1200")
("spellcheck.rkt")
("spectralnorm.rkt" "5500")
("spectralnorm-unsafe.rkt" "5500")
("strcat.rkt" "40000")
("sumcol.rkt" #f ,(lambda () (mk-sumcol-input)))
("wc.rkt")
("wordfreq.rkt")
))
(define-runtime-path here ".")
@ -56,7 +56,7 @@
(with-output-to-file f
(lambda ()
(parameterize ([current-command-line-arguments (vector n)])
(dynreq "fasta.ss")))))
(dynreq "fasta.rkt")))))
f))
(define (mk-revcomp-input)

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

@ -1,5 +1,6 @@
;; Works for Linux, Mac OS X.
;; Assumes 3m
;; Works for Linux.
;; Almost works for Mac OS X.
;; Assumes 3m.
(load-relative "loadtest.rkt")
@ -8,7 +9,7 @@
(require scheme/system
setup/dirs)
(define dir (collection-path "tests" "mzscheme"))
(define dir (collection-path "tests" "racket"))
(define lib-dir (find-lib-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"
(case (system-type 'link)
[(framework)
(format "-F\"~a\" -framework PLT_MzScheme" lib-dir)]
(format "-F\"~a\" -framework Racket" lib-dir)]
[(static shared)
(format "-L\"~a\" -lmzscheme3m" lib-dir)]
(format "-L\"~a\" -lracket3m" lib-dir)]
[else
(error "unsupported")])))

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

@ -1,6 +1,6 @@
;; Basic checks for the intermediate language. See also
;; beginner.ss
;; beginner.rkt
(load-relative "loadtest.rkt")
@ -9,26 +9,26 @@
;; Check export names:
(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
(lambda (row)
(for-each
(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)
(test (car doc) object-name v))))
(cdr row)))
docs))
(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-intml.ss")
(load-relative "bega-adv.ss")
(load-relative "intm-intml.ss")
(load-relative "intm-adv.ss")
(load-relative "beg-adv.rkt")
(load-relative "beg-intml.rkt")
(load-relative "bega-adv.rkt")
(load-relative "intm-intml.rkt")
(load-relative "intm-adv.rkt")
(report-errs)

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

@ -1,6 +1,6 @@
;; Basic checks for the intermediate language. See also
;; beginner.ss
;; beginner.rkt
(load-relative "loadtest.rkt")
@ -9,27 +9,27 @@
;; Check export names:
(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
(lambda (row)
(for-each
(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)
(test (car doc) object-name v))))
(cdr row)))
docs))
(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-intml.ss")
(load-relative "beg-intm.ss")
(load-relative "bega-adv.ss")
(load-relative "intm-intml.ss")
(load-relative "intm-adv.ss")
(load-relative "beg-adv.rkt")
(load-relative "beg-intml.rkt")
(load-relative "beg-intm.rkt")
(load-relative "bega-adv.rkt")
(load-relative "intm-intml.rkt")
(load-relative "intm-adv.rkt")
(report-errs)

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

@ -11,7 +11,7 @@
;; It relies on list-library.ss.
(load-relative "listlib.ss")
(load-relative "listlib.rkt")
;; representations of fields, states, and collections of states
(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
;; 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
(define null '())

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

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