From 043f97df974455b8dbc9d67548079a2f982cd1d5 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 1 May 2010 07:23:05 -0600 Subject: [PATCH] fix more test files --- collects/lang/posn.rkt | 11 ++- collects/lang/private/beginner-funs.rkt | 2 +- collects/lang/private/teach.rkt | 5 +- collects/lang/private/teachprims.rkt | 6 ++ collects/tests/racket/advanced.rkt | 18 ++--- collects/tests/racket/beginner-abbr.rkt | 14 ++-- collects/tests/racket/beginner.rkt | 14 ++-- collects/tests/racket/benchmarks/rx/auto.rkt | 6 +- .../tests/racket/benchmarks/shootout/run.rkt | 80 +++++++++---------- collects/tests/racket/embed-in-c.rkt | 11 +-- collects/tests/racket/intermediate-lambda.rkt | 20 ++--- collects/tests/racket/intermediate.rkt | 22 ++--- collects/tests/racket/ttt/tic-bang.rkt | 2 +- collects/tests/racket/ttt/tic-func.rkt | 4 +- collects/tests/racket/ttt/ttt.rkt | 6 +- 15 files changed, 118 insertions(+), 103 deletions(-) diff --git a/collects/lang/posn.rkt b/collects/lang/posn.rkt index 333637c2fe..479b4b85aa 100644 --- a/collects/lang/posn.rkt +++ b/collects/lang/posn.rkt @@ -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)) diff --git a/collects/lang/private/beginner-funs.rkt b/collects/lang/private/beginner-funs.rkt index 2de47bccff..e7ee53b0d8 100644 --- a/collects/lang/private/beginner-funs.rkt +++ b/collects/lang/private/beginner-funs.rkt @@ -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) diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index a28073cc50..f6547a4490 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -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))))]) diff --git a/collects/lang/private/teachprims.rkt b/collects/lang/private/teachprims.rkt index e1c1be29e0..bbd667e1f3 100644 --- a/collects/lang/private/teachprims.rkt +++ b/collects/lang/private/teachprims.rkt @@ -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* diff --git a/collects/tests/racket/advanced.rkt b/collects/tests/racket/advanced.rkt index efcb3e6570..c2db397f69 100644 --- a/collects/tests/racket/advanced.rkt +++ b/collects/tests/racket/advanced.rkt @@ -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))) diff --git a/collects/tests/racket/beginner-abbr.rkt b/collects/tests/racket/beginner-abbr.rkt index 98cd79eae9..5088f74a78 100644 --- a/collects/tests/racket/beginner-abbr.rkt +++ b/collects/tests/racket/beginner-abbr.rkt @@ -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) diff --git a/collects/tests/racket/beginner.rkt b/collects/tests/racket/beginner.rkt index 1f8662ede7..e0869696d3 100644 --- a/collects/tests/racket/beginner.rkt +++ b/collects/tests/racket/beginner.rkt @@ -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) diff --git a/collects/tests/racket/benchmarks/rx/auto.rkt b/collects/tests/racket/benchmarks/rx/auto.rkt index 20b33fd607..939068eba2 100755 --- a/collects/tests/racket/benchmarks/rx/auto.rkt +++ b/collects/tests/racket/benchmarks/rx/auto.rkt @@ -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) diff --git a/collects/tests/racket/benchmarks/shootout/run.rkt b/collects/tests/racket/benchmarks/shootout/run.rkt index 1e81b4ee46..b68064e563 100644 --- a/collects/tests/racket/benchmarks/shootout/run.rkt +++ b/collects/tests/racket/benchmarks/shootout/run.rkt @@ -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) diff --git a/collects/tests/racket/embed-in-c.rkt b/collects/tests/racket/embed-in-c.rkt index d13cc8318c..bb11600367 100644 --- a/collects/tests/racket/embed-in-c.rkt +++ b/collects/tests/racket/embed-in-c.rkt @@ -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")]))) diff --git a/collects/tests/racket/intermediate-lambda.rkt b/collects/tests/racket/intermediate-lambda.rkt index 637db6e117..7cddebc5c6 100644 --- a/collects/tests/racket/intermediate-lambda.rkt +++ b/collects/tests/racket/intermediate-lambda.rkt @@ -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) diff --git a/collects/tests/racket/intermediate.rkt b/collects/tests/racket/intermediate.rkt index 64549dc75f..e6741b9475 100644 --- a/collects/tests/racket/intermediate.rkt +++ b/collects/tests/racket/intermediate.rkt @@ -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) diff --git a/collects/tests/racket/ttt/tic-bang.rkt b/collects/tests/racket/ttt/tic-bang.rkt index 9bb9e5ac8c..5ba990e185 100644 --- a/collects/tests/racket/ttt/tic-bang.rkt +++ b/collects/tests/racket/ttt/tic-bang.rkt @@ -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) diff --git a/collects/tests/racket/ttt/tic-func.rkt b/collects/tests/racket/ttt/tic-func.rkt index 967c9b6415..fd25ad6462 100644 --- a/collects/tests/racket/ttt/tic-func.rkt +++ b/collects/tests/racket/ttt/tic-func.rkt @@ -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 '()) diff --git a/collects/tests/racket/ttt/ttt.rkt b/collects/tests/racket/ttt/ttt.rkt index 3e09bf0387..d5a1c6acbe 100644 --- a/collects/tests/racket/ttt/ttt.rkt +++ b/collects/tests/racket/ttt/ttt.rkt @@ -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)