diff --git a/collects/lang/htdp-beginner.rkt b/collects/lang/htdp-beginner.rkt index 555dec3039..8261b119e8 100644 --- a/collects/lang/htdp-beginner.rkt +++ b/collects/lang/htdp-beginner.rkt @@ -55,10 +55,6 @@ (require (for-syntax "private/firstorder.ss")) - ;; This is essentially a specialized version of `define-primitive' - ;; that refines the error messages for built-in things, which - ;; we might like to call "contructor" or "predicate" instead of - ;; just "primitive". (define-syntax (in-rator-position-only stx) (syntax-case stx () [(_ new-name orig-name) @@ -67,35 +63,19 @@ ;; Some things are not really functions: (if (memq (syntax-e orig) '(beginner:pi beginner:e beginner:null beginner:eof)) #'(define new-name orig-name) - (with-syntax ([(what something) - (case (syntax-e orig) - [(beginner:make-posn) - #'("constructor" - "called with values for the structure fields")] - [(beginner:posn-x beginner:posn-y) - #'("selector" - "applied to a structure to get the field value")] - [(beginner:posn?) - #'("predicate" - "applied to an argument")] - [else - #'("primitive operator" - "applied to arguments")])]) - #'(define-syntax new-name - (make-first-order - (lambda (stx) - (syntax-case stx () - [(id . args) - (syntax/loc stx - (with-handlers ([exn:fail:contract? (compose raise rewrite-contract-error-message)]) - (beginner-app orig-name . args)))] - [_else - (raise-syntax-error - #f - (format - "found a use that does not follow an open parenthesis") - stx)])) - #'orig-name)))))])) + #'(define-syntax new-name + (make-first-order + (lambda (stx) + (syntax-case stx () + [(id . args) + ((wrap-for-contract-error-message #'beginner-app) #'orig-name stx)] + [_else + (raise-syntax-error + #f + (format + "found a use that does not follow an open parenthesis") + stx)])) + #'orig-name))))])) ;; procedures: (provide-and-document/wrap diff --git a/collects/lang/htdp-intermediate.rkt b/collects/lang/htdp-intermediate.rkt index 7459446544..cdabf8c06e 100644 --- a/collects/lang/htdp-intermediate.rkt +++ b/collects/lang/htdp-intermediate.rkt @@ -3,11 +3,11 @@ (require "private/teach.ss" "private/teachprims.ss" "private/teach-module-begin.ss" - "private/rewrite-error-message.rkt" mzlib/etc mzlib/list syntax/docprovide - test-engine/scheme-tests) + test-engine/scheme-tests + (for-syntax scheme/base)) ;; syntax: (provide (rename-out @@ -55,7 +55,7 @@ ; check-property for-all ==> expect expect-within expect-member-of expect-range ) - ;; procedures: + (provide-and-document procedures (all-from beginner: lang/private/intermediate-funs procedures)) diff --git a/collects/lang/private/rewrite-error-message-for-tpl.rkt b/collects/lang/private/rewrite-error-message-for-tpl.rkt new file mode 100755 index 0000000000..6d4d56aee8 --- /dev/null +++ b/collects/lang/private/rewrite-error-message-for-tpl.rkt @@ -0,0 +1,36 @@ +#lang scheme/base + +(require scheme/list) + +(provide rewrite-lookup-error-message + rewrite-contract-error-message) + +(define (rewrite-lookup-error-message e id was-in-app-position) + (let ([var-or-function (if was-in-app-position "function" "variable")]) + (raise-syntax-error + #f + (format "this ~a is not defined" var-or-function) + id))) + +(define (change-contract-exn-messages e msg) + (define constructor + (cond [(exn:fail:contract:arity? e) make-exn:fail:contract:arity] + [(exn:fail:contract:divide-by-zero? e) make-exn:fail:contract:divide-by-zero] + [(exn:fail:contract:non-fixnum-result? e) make-exn:fail:contract:non-fixnum-result] + [(exn:fail:contract:continuation? e) make-exn:fail:contract:continuation] + [else make-exn:fail:contract])) + (constructor msg (exn-continuation-marks e))) + +(define (rewrite-contract-error-message e) + (define replacements + (list (list #rx"expects argument of type (<([^>]+)>)" + (lambda (all one two) (format "expects a ~a" two))) + (list #rx"expects type (<([^>]+)>)" + (lambda (all one two) (format "expects a ~a" two))) + (list #rx"^procedure " + (lambda (all) "")) + )) + (define new-message + (for/fold ([msg (exn-message e)]) ([repl. replacements]) + (regexp-replace* (first repl.) msg (second repl.)))) + (change-contract-exn-messages e new-message)) \ No newline at end of file diff --git a/collects/lang/private/rewrite-error-message.rkt b/collects/lang/private/rewrite-error-message.rkt index 86cb09d9dd..be16425aac 100755 --- a/collects/lang/private/rewrite-error-message.rkt +++ b/collects/lang/private/rewrite-error-message.rkt @@ -1,68 +1,29 @@ #lang scheme/base -(require mzlib/etc mzlib/list) -(require (for-syntax scheme/base)) -(require (for-syntax "firstorder.ss")) +(require mzlib/etc + mzlib/list + (for-template scheme/base "rewrite-error-message-for-tpl.rkt") + (for-syntax "firstorder.ss" + scheme/base)) -(provide rewrite-contract-error-message - rewrite-lookup-error-message/rand - rewrite-lookup-error-message/rator - wrap-for-contract-error-message - wrap-for-lookup-error-message - ::) +(provide wrap-top-for-lookup-error-message + wrap-for-contract-error-message) -(define (rewrite-lookup-error-message/rator e) - (rewrite-lookup-error-message e "function")) - -(define (rewrite-lookup-error-message/rand e) - (rewrite-lookup-error-message e "variable")) - -(define (rewrite-lookup-error-message e var-or-function) - (define new-message - (regexp-replace* #rx"reference to an identifier before its definition" - (exn-message e) - (format "this is ~a not defined" var-or-function))) - (struct-copy exn e [message new-message])) - -(define-syntax (wrap-for-lookup-error-message stx) +(define (wrap-top-for-lookup-error-message stx was-in-app-position) (syntax-case stx () [(_ . id) - (with-syntax ([top (syntax/loc stx #%top)]) - (syntax/loc stx - (with-handlers ([exn:fail:contract:variable? - (compose raise rewrite-lookup-error-message)]) - (top . id))))])) + (quasisyntax/loc + stx + (with-handlers ([exn:fail:contract:variable? + (lambda (e) (rewrite-lookup-error-message e #'id #,was-in-app-position))]) + (#%top . id)))])) -(define (change-contract-exn-messages e msg) - (define constructor - (cond [(exn:fail:contract:arity? e) make-exn:fail:contract:arity] - [(exn:fail:contract:divide-by-zero? e) make-exn:fail:contract:divide-by-zero] - [(exn:fail:contract:non-fixnum-result? e) make-exn:fail:contract:non-fixnum-result] - [(exn:fail:contract:continuation? e) make-exn:fail:contract:continuation] - [else make-exn:fail:contract])) - (constructor msg (exn-continuation-marks e))) -(define (rewrite-contract-error-message e) - (define replacements - (list (list #rx"expects argument of type (<([^>]+)>)" - (lambda (all one two) (format "expects a ~a" two))) - (list #rx"expects type (<([^>]+)>)" - (lambda (all one two) (format "expects a ~a" two))) - (list #rx"^procedure " - (lambda (all) "")) - )) - (define new-message - (for/fold ([msg (exn-message e)]) ([repl. replacements]) - (regexp-replace* (first repl.) msg (second repl.)))) - (change-contract-exn-messages e new-message)) - -(define-for-syntax (wrap-for-contract-error-message* stx) +(define ((wrap-for-contract-error-message app) orig-name stx) (syntax-case stx () - [(_ new old) - #'(define (new . args) - (with-handlers ([exn:fail:contract? (compose raise rewrite-contract-error-message)]) - (apply old args)))])) + [(id . args) + (quasisyntax/loc stx + (with-handlers ([exn:fail:contract? (compose raise rewrite-contract-error-message)]) + #,(quasisyntax/loc stx (#,app #,orig-name . args))))])) -(define-syntax wrap-for-contract-error-message wrap-for-contract-error-message*) -(define-syntax :: wrap-for-contract-error-message*) ;; to circumvent most of the ugliness of provide-and-document/wrap's renaming of the function's infered name \ No newline at end of file diff --git a/collects/lang/private/teach.rkt b/collects/lang/private/teach.rkt index baf0f7ca0c..02408b7f55 100644 --- a/collects/lang/private/teach.rkt +++ b/collects/lang/private/teach.rkt @@ -40,7 +40,6 @@ scheme/match "set-result.rkt" (only racket/base define-struct) - "rewrite-error-message.rkt" racket/struct-info deinprogramm/signature/signature-english (all-except deinprogramm/signature/signature signature-violation) @@ -54,16 +53,18 @@ (only lang/private/teachprims beginner-equal? beginner-equal~? teach-equal? advanced-cons advanced-list*)) - (require-for-syntax "teachhelp.rkt" - "teach-shared.rkt" - syntax/kerncase - syntax/stx - syntax/struct - syntax/context - mzlib/include - scheme/list - (rename racket/base racket:define-struct define-struct) - (only racket/base syntax->datum datum->syntax) + + (require-for-syntax "teachhelp.ss" + "teach-shared.ss" + "rewrite-error-message.rkt" + syntax/kerncase + syntax/stx + syntax/struct + syntax/context + mzlib/include + scheme/list + (rename racket/base racket:define-struct define-struct) + (only racket/base syntax->datum datum->syntax) (rename racket/base kw-app #%app) racket/struct-info stepper/private/shared @@ -104,7 +105,7 @@ [exn:fail:syntax? (lambda (exn) #t)]) (namespace-variable-value (syntax-e id) #t) #t))) - (error who "cannot redefine name: ~a" (syntax-e id)))) + (raise-syntax-error #f "this name was defined previously and cannot be re-defined" id))) ;; For quasiquote and shared: (require (rename "teachprims.rkt" the-cons advanced-cons)) @@ -317,10 +318,10 @@ (let ([b (identifier-binding name)]) (when b (teach-syntax-error - 'duplicate - stx + (syntax-e name) + name #f - "~a was defined previously and cannot be re-defined" (syntax-e name))))) + "this name was defined previously and cannot be re-defined")))) names) (if assign (with-syntax ([(name ...) (if (eq? assign #t) @@ -1068,7 +1069,7 @@ (with-syntax ([(name? variant? ...) (map (lambda (stx) - (datum->syntax stx (string->symbol (format "~a?" (syntax->datum stx))))) + (datum->syntax stx (string->symbol (format "~a?" (syntax->datum stx))) stx)) (syntax->list #'(name variant ...)))]) ;; Here we are using an explicit loop and the "/proc" functions instead of producing a syntax with "..." ;; to preserve the syntax location information. @@ -1220,14 +1221,10 @@ ;; delay the check. (stepper-ignore-checker (syntax/loc stx (#%app values (beginner-top-continue id)))) - (with-syntax ([rewriter - (if (syntax-property #'id 'was-in-app-position) - 'rewrite-lookup-error-message/rator - 'rewrite-lookup-error-message/rand)]) - (syntax/loc stx - (with-handlers ([exn:fail:contract:variable? - (compose raise rewriter)]) - (#%top . id)))))])) + + (wrap-top-for-lookup-error-message + stx + (syntax-property #'id 'was-in-app-position)))])) (define (beginner-top-continue/proc stx) (syntax-case stx () @@ -2049,7 +2046,7 @@ "found a variable that is used more than once: ~a" (syntax-e dup)))) (check-single-expression 'lambda - "after the variables" + "for the function body" stx (syntax->list (syntax (lexpr ...))) args) @@ -2227,7 +2224,7 @@ ;; new syntax object that is an `intermediate-define' form; ;; that's important for syntax errors, so that they ;; report `advanced-define' as the source. - (define/proc #f #t stx #'beginner-lambda)] + (define/proc #f #t stx #'beginner-lambda)] [_else (bad-use-error 'define stx)])) @@ -2260,7 +2257,7 @@ "found a variable that is used more than once: ~a" (syntax-e dup)))) (check-single-expression 'lambda - "after the variables" + "for the function body" stx (syntax->list (syntax exprs)) names) @@ -2339,18 +2336,19 @@ 'set! stx (syntax id) - "expected a mutable variable after set!, but found a variable that cannot be modified"))) + "expected a mutable variable after set!, but found a variable that cannot be modified: ~a" + (syntax-e #'id)))) ;; If we're in a module, we'd like to check here whether ;; the identier is bound, but we need to delay that check ;; in case the id is defined later in the module. So only ;; do this in continuing mode: - (when continuing? + (when continuing? (let ([binding (identifier-binding #'id)]) (cond [(and (not binding) (syntax-source-module #'id)) (teach-syntax-error - 'unknown + #f #'id #f "this variable is not defined")] @@ -2359,23 +2357,26 @@ (let-values ([(path rel) (module-path-index-split (car binding))]) path))) (teach-syntax-error - 'unknown + 'set! #'id #f - "expected a mutable variable after set!, but found a variable that cannot be modified")]))) + "expected a mutable variable after set!, but found a variable that cannot be modified: ~a" + (syntax-e #'id))]))) ;; Check the RHS (check-single-expression 'set! "for the new value" stx exprs null) + (if continuing? (stepper-syntax-property - (syntax/loc stx (begin (set! id expr ...) set!-result)) + (quasisyntax/loc stx (begin #,(datum->syntax #'here `(set! ,#'id ,@(syntax->list #'(expr ...))) stx) set!-result)) 'stepper-skipto (append skipto/cdr skipto/first)) - (stepper-ignore-checker (syntax/loc stx (#%app values (advanced-set!-continue id expr ...))))))] + (stepper-ignore-checker (quasisyntax/loc stx (#%app values #,(advanced-set!-continue/proc + (syntax/loc stx (_ id expr ...))))))))] [(_ id . __) (teach-syntax-error 'set! @@ -2574,7 +2575,7 @@ 'case stx choices - "expected at least one choice (in parentheses), but nothing's there")) + "expected a symbol (without its quote) or a number as a choice, but nothing's there")) (check-single-expression 'case "for the answer in the case clause" clause diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 864617c3aa..27f1f3928c 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -1,1540 +1,1462 @@ -#lang scheme - -#| - -Make sure there are tests that cover these parameters: - - (read-case-sensitive #f) - (read-square-bracket-as-paren #f) -- test: (symbol? '[]) - (read-curly-brace-as-paren #f) - (print-vector-length #f) - -the settings above should match r5rs - -|# - - -(require "drracket-test-util.rkt" - tests/utils/gui - mred - framework - (prefix-in fw: framework)) - -(define language (make-parameter "<>")) -(define defs-prefix (make-parameter "")) - -;; set-language : boolean -> void -(define (set-language close-dialog?) - (if (eq? (car (language)) 'module) - (set-module-language! close-dialog?) - (set-language-level! (language) close-dialog?))) - - -; -; -; -; -; ;; ;; -; ;; ;; -; ;;;;; ;; ;;; ;;;;; ;; ;; ;; ;;;; -; ;;;;;;;;; ;;;;; ;;;;; ;; ;; ;; ;; ;;; -; ;; ;; ;; ;;; ;;;;; ;; ;; ;; ;; ;;;;;;; -; ;; ;; ;; ;;; ;;;;; ;; ;; ;; ;; ;;; -; ;; ;; ;; ;;;;; ;;;;; ;;;;; ;; ;; ;; -; ;; ;; ;; ;;; ;;;;; ;;;;; ;; ;;;; -; -; -; -; - -(define (module-lang) - (parameterize ([language '(module "racket")] - [defs-prefix "#lang racket\n"]) - - (check-top-of-repl) - - (prepare-for-test-expression) - - (test-expression "'|.|" "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "#t") - (test-expression "(define x 1)(define x 2)" #rx"duplicate definition for identifier in: x" "") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "#" - "define-values: cannot re-define a constant: struct:spider\n#") - - (test-expression "(sqrt -1)" "0+1i") - - (test-expression "class" (regexp "class: bad syntax in: class")) - (test-expression "shared" (regexp "shared: bad syntax in: shared")) - - (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"" "") - (test-expression "'(1 . 2)" "'(1 . 2)") - - (test-expression "(define (f define) 1)" "" "define-values: cannot re-define a constant: f") - (test-expression "(define (f car) 1)" "" "define-values: cannot re-define a constant: f") - (test-expression "(define (f empty) 1)" "" "define-values: cannot re-define a constant: f") - - (test-expression "call/cc" "#") - - (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} a: 1") - (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} a \"a\"") - - (test-expression "(time 1)" - #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") - - (test-expression "true" "#t") - (test-expression "mred^" - #rx"unbound identifier in module in: mred\\^" - #rx"reference to undefined identifier: mred\\^") - (test-expression "(eq? 'a 'A)" "#f") - (test-expression "(set! x 1)" - #rx"set!: unbound identifier in module in: x" - #rx"set!: cannot set undefined variable: x") - (test-expression "(define qqq 2) (set! qqq 1)" "") - (test-expression "(cond [(= 1 2) 3])" "") - (test-expression "(cons 1 2)" "'(1 . 2)") - (test-expression "(+ (list 1) 2)" (regexp (regexp-quote "+: expects type as 1st argument, given: '(1); other arguments were: 2"))) - (test-expression "'(1)" "'(1)") - (test-expression "(define shrd (box 1)) (list shrd shrd)" - "'(#&1 #&1)" - "define-values: cannot re-define a constant: shrd\n'(#&1 #&1)") - (test-expression "(local ((define x x)) 1)" "1") - (test-expression "(letrec ([x x]) 1)" "1") - (test-expression "(if 1 1 1)" "1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1.0") - (test-expression "#i1.0" "1.0") - (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") - (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") - (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") - (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") - (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") - (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") - (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") - (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") - (test-expression "+1/3i" "0+1/3i") - (test-expression "+1/2i" "0+1/2i") - (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") - (test-expression "(exact? 1.5)" "#f") - (test-expression "(print (floor (sqrt 2)))" "1.0") - - (test-expression "(let ([f (lambda (x) x)]) f)" "#") - (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") - - (test-expression "(list 1)" "'(1)") - (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type ; given '()") - - (test-expression "(current-command-line-arguments)" "'#()") - (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") - - (test-expression "#lang racket" #rx"module: illegal use \\(not at top-level\\)" #rx"read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "a: b"))) - - -; -; -; -; ; ; ;;;; ;; -; ;; ;; ;;;; ;; -; ;;;;;;; ;;; ;;; ;;; ;;;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;;;; -; ;;;;;;;; ;;;;;;; ;;;;; ;;;;;; ;;;;;; ;;; ;;;; ;;;;;;;; ;;;; ;;;;;;;; -; ;;;;;;;;; ;;;; ;; ;;;; ;; ;;;; ;;;; ;;;;;; ;;;;;;;;; ;;;; ;;; ;;;; -; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;; ;;;;;; ;;;; ;;;; ;;;; ;;;;;;;; -; ;;;;;;;;; ;;;; ;;;;; ;;;;; ;;;;; ;;;;; ;;;;;;;;; ;;;; ;;;;;;; -; ;;;;;;;; ;;;; ;;;;;; ;;;;; ;;;;; ;;;; ;;;;;;;; ;;;; ; ;;;; -; ;;;;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;;;;;; -; ;;;; ;;;; ;;;;;;;; -; ;;;; ;;;; ;;;;;; -; - -(define (pretty-big) - (parameterize ([language (list #rx"Pretty Big")]) - - (check-top-of-repl) - - (generic-settings #f) - (generic-output #t #t #t #t) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" "|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "#t") - (test-expression "(define x 1)(define x 2)" "") - - (test-expression "(define-struct spider (legs))(make-spider 4)" "#") - - (test-expression "(sqrt -1)" "0+1i") - - (test-expression "class" (regexp "class: bad syntax in: class")) - (test-expression "shared" (regexp "shared: bad syntax in: shared")) - - (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"") - (test-expression "'(1 . 2)" "(1 . 2)") - - (test-expression "(define (f define) 1)" "") - (test-expression "(define (f car) 1)" "") - (test-expression "(define (f empty) 1)" "") - - (test-expression "call/cc" "#") - - (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} a: 1") - (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} a \"a\"") - - (test-expression "(time 1)" - #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") - - (test-expression "true" "#t") - (test-expression "mred^" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: mred^") - (test-expression "(eq? 'a 'A)" "#f") - (test-expression "(set! x 1)" "{stop-multi.png} {stop-22x22.png} set!: cannot set undefined variable: x") - (test-expression "(define qqq 2) (set! qqq 1)" "") - (test-expression "(cond [(= 1 2) 3])" "") - (test-expression "(cons 1 2)" "(1 . 2)") - (test-expression "(+ (list 1) 2)" "{stop-multi.png} {stop-22x22.png} +: expects type as 1st argument, given: (1); other arguments were: 2") - (test-expression "'(1)" "(1)") - (test-expression "(define shrd (box 1)) (list shrd shrd)" - "(#&1 #&1)") - (test-expression "(local ((define x x)) 1)" "1") - (test-expression "(letrec ([x x]) 1)" "1") - (test-expression "(if 1 1 1)" "1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1.0") - (test-expression "#i1.0" "1.0") - (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") - (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") - (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") - (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") - (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") - (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") - (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") - (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") - (test-expression "+1/3i" "0+1/3i") - (test-expression "+1/2i" "0+1/2i") - (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") - (test-expression "(exact? 1.5)" "#f") - (test-expression "(print (floor (sqrt 2)))" "1.0") - - (test-expression "(let ([f (lambda (x) x)]) f)" "#") - (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") - - (test-expression "(list 1)" "(1)") - (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type ; given ()") - - (test-expression "(current-command-line-arguments)" "#()") - (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") - - (test-expression "#lang racket" - "" - #rx"read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "a: b"))) - -; -; -; ;;;;;;; ;;;;;;; ;;;;;; -; ;; ;; ;; ;; ;; ;; -; ;; ;; ;;;;; ;; ;; ;; ; -; ;; ;; ;;;;; ;; ;; ;;;; -; ;;;;;; ; ;;;;;; ;;;;; -; ;; ;; ;;;; ;; ;; ;;; -; ;; ;; ;; ;; ;; ; ;; -; ;; ;; ;; ;; ;; ;; ;; -; ;;;; ;;; ;; ;; ;;;; ;;;;;;;;; -; ;; ;; -; ;;;; -; - - -(define (r5rs) - (parameterize ([language (list (regexp "R5RS"))]) - - (check-top-of-repl) - - (generic-settings #f) - (generic-output #t #t #t #t) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" "|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "#t") - (test-expression "(define x 1)(define x 2)" "") - - (test-expression - "(define-struct spider (legs))(make-spider 4)" - "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: define-struct" - "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: define-struct\n{stop-multi.png} {stop-22x22.png} reference to undefined identifier: make-spider") - - (test-expression "(sqrt -1)" "0+1i") - - (test-expression "class" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: class") - (test-expression "shared" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: shared") - - (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"") - (test-expression "'(1 . 2)" "(1 . 2)") - - (test-expression "(define (f define) 1)" "") - (test-expression "(define (f car) 1)" "") - (test-expression "(define (f empty) 1)" "") - - (test-expression "call/cc" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: error") - (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: error") - - (test-expression "(time 1)" - "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: time") - - (test-expression "true" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: true") - (test-expression "mred^" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: mred^") - (test-expression "(eq? 'a 'A)" "#t") - (test-expression "(set! x 1)" "{stop-multi.png} {stop-22x22.png} set!: cannot set undefined variable: x") - (test-expression "(define qqq 2) (set! qqq 1)" "") - (test-expression "(cond ((= 1 2) 3))" "") - (test-expression "(cons 1 2)" "(1 . 2)") - (test-expression "(+ (list 1) 2)" "{stop-multi.png} {stop-22x22.png} +: expects type as 1st argument, given: (1); other arguments were: 2") - (test-expression "'(1)" "(1)") - (test-expression "(define shrd (cons 1 1)) (list shrd shrd)" - "((1 . 1) (1 . 1))") - (test-expression - "(local ((define x x)) 1)" - #rx"define: not allowed in an expression context") - (test-expression "(letrec ((x x)) 1)" "1") - (test-expression "(if 1 1 1)" "1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1.0") - (test-expression "#i1.0" "1.0") - (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") - (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") - (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") - (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") - (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") - (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") - (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") - (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") - (test-expression "+1/3i" "0+1/3i") - (test-expression "+1/2i" "0+1/2i") - (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") - (test-expression "(exact? 1.5)" "#f") - (test-expression "(print (floor (sqrt 2)))" #rx"reference to undefined identifier: print") - - (test-expression "(let ((f (lambda (x) x))) f)" "#") - (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") - - (test-expression "(list 1)" "(1)") - (test-expression "(car (list))" - "{stop-multi.png} {stop-22x22.png} mcar: expects argument of type ; given ()") - - (test-expression "argv" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: argv") - (test-expression "(define-syntax app syntax-case)" - "{stop-22x22.png} macro-transformer: only a `syntax-rules' form is allowed in: syntax-case") - - (test-expression "#lang racket" - (regexp (regexp-quote "#%module-begin: illegal use (not a module body) in: (#%module-begin)")) - #rx"read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - #rx"reference to undefined identifier:"))) - - -; -; ;;; ;; -; ;; ;; -; ;; -; ;;;;; ;;;; ;;;;;;;;; ;;; ;; ;;; ;; ;;;; ;;; ;; -; ;; ;; ;; ;; ;; ;; ;; ;;; ;; ;;; ;; ;; ;; ;;;;; -; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; -; ;; ;; ;;;;;; ;;;; ;; ;; ;; ;; ;; ;;;;;; ;; -; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; -; ;; ;; ;; ; ;;;;; ;; ;; ;; ;; ;; ;; ; ;; -; ;;;;; ;;;; ;;;;;;;;;; ;;;; ;;; ;;;; ;;; ;;;; ;;;; -; ;; ;; -; ;; ;; -; ;;;;; - -(define (beginner) - (parameterize ([language (list "How to Design Programs" #rx"Beginning Student(;|$)")]) - (check-top-of-repl) - (generic-settings #t) - (generic-output #f #f #f #f) - (teaching-language-fraction-output) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" - "'|.|" - "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "true" - "true") - - (test-expression "(define x 1)(define x 2)" - "x: this name was defined previously and cannot be re-defined" - "define: cannot redefine name: x") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "(make-spider 4)" - "define-struct: cannot redefine name: spider\n(make-spider 4)") - - (test-expression "(sqrt -1)" - "0+1i" - "0+1i\n") - - (test-expression "class" - "class: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: class") - (test-expression "shared" - "shared: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: shared") - (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") - (test-expression "'(1 . 2)" "read: illegal use of \".\"") - - (test-expression "call/cc" - "call/cc: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "a: ~a1") - (test-expression "(error \"a\" \"a\")" "aa") - - (test-expression "(time 1)" - "time: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: time") - - (test-expression "true" - "true" - "true") - (test-expression "mred^" - "mred^: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: mred^") - (test-expression "(eq? 'a 'A)" - "false" - "false") - (test-expression "(set! x 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(define qqq 2) (set! qqq 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - - (test-expression "(cond [(= 1 2) 3])" - "cond: all question results were false") - (test-expression "(cons 1 2)" - "cons: second argument must be of type , given 1 and 2") - (test-expression "(+ (list 1) 2)" - "+: expects type as 1st argument, given: (cons 1 empty); other arguments were: 2") - (test-expression "'(1)" - "quote: expected a name after a ', found something else") - (test-expression "(define shrd (list 1)) (list shrd shrd)" - "(cons (cons 1 empty) (cons (cons 1 empty) empty))" - "define: cannot redefine name: shrd\n(cons (cons 1 empty) (cons (cons 1 empty) empty))") - (test-expression "(local ((define x x)) 1)" - "local: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression "(letrec ([x x]) 1)" - "letrec: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "procedure +: expects at least 2 arguments, given 1: 1") - - (test-expression "1.0" "1" "1") - (test-expression "#i1.0" "#i1.0" "#i1.0") - (test-expression "4/3" - "{number 4/3 \"1.3\" decimal}" - "{number 4/3 \"1.3\" decimal}") - (test-expression "1/3" - "{number 1/3 \"0.3\" decimal}" - "{number 1/3 \"0.3\" decimal}") - (test-expression "-4/3" - "{number -4/3 \"-1.3\" decimal}" - "{number -4/3 \"-1.3\" decimal}") - (test-expression "-1/3" - "{number -1/3 \"-0.3\" decimal}" - "{number -1/3 \"-0.3\" decimal}") - (test-expression "3/2" - "{number 3/2 \"1.5\" decimal}" - "{number 3/2 \"1.5\" decimal}") - (test-expression "1/2" - "{number 1/2 \"0.5\" decimal}" - "{number 1/2 \"0.5\" decimal}") - (test-expression "-1/2" - "{number -1/2 \"-0.5\" decimal}" - "{number -1/2 \"-0.5\" decimal}") - (test-expression "-3/2" - "{number -3/2 \"-1.5\" decimal}" - "{number -3/2 \"-1.5\" decimal}") - (test-expression "+1/3i" - "0+1/3i" - "0+1/3i") - (test-expression "+1/2i" - "0+0.5i" - "0+0.5i") - (test-expression "779625/32258" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" "true") - (test-expression "(print (floor (sqrt 2)))" - "print: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: print") - - (test-expression "(let ([f (lambda (x) x)]) f)" - "let: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression ",1" - "read: illegal use of comma") - - (test-expression "(list 1)" - "(cons 1 empty)" - "(cons 1 empty)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") - - (test-expression "argv" - "argv: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: argv") - (test-expression "(define-syntax app syntax-case)" - "define-syntax: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: define-syntax") - - (test-expression "#lang racket" - "module: name is not defined, not a parameter, and not a primitive name" - "read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "define: expected at least one argument name after the function name, but found none" - #rx"define: function definitions are not allowed in the interactions window"))) - - -; -; ;;; ;;; ;;; -; ;; ; ;; ;; -; ;; ; ;; ;; -; ;;;;; ;;;; ;;;;;; ; ;;;; ;;;;; ;;;;; ;;; ;; ;;;; ;;; ;;; -; ;; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;;;;; ;; ;; ;; ; -; ;; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; ;; ;; ; -; ;; ;; ;;;;;; ;;;; ; ;;;;; ;; ;; ;; ;; ;; ;;;;;; ;;; -; ;; ;; ;; ; ; ;; ;; ;; ;; ;; ;; ;; ;; ;;; -; ;; ;; ;; ; ;;;;; ; ;; ;; ;; ;; ;; ;; ;; ;; ; ;;; -; ;;;;; ;;;; ;;;;;; ; ;;;;;; ;;;;; ;;;;; ;;;; ;;;; ; -; ;; ;;; -; ;; ;;; -; ;;;;; - - -(define (beginner/abbrev) - (parameterize ([language (list "How to Design Programs" - #rx"Beginning Student with List Abbreviations(;|$)")]) - (check-top-of-repl) - - (generic-settings #t) - (generic-output #t #f #f #f) - (teaching-language-fraction-output) - - (test-hash-bang) - - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" - "'|.|" - "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "true" - "true") - - (test-expression "(define x 1)(define x 2)" - "x: this name was defined previously and cannot be re-defined" - "define: cannot redefine name: x") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "(make-spider 4)" - "define-struct: cannot redefine name: spider\n(make-spider 4)") - - (test-expression "(sqrt -1)" - "0+1i" - "0+1i") - - (test-expression "class" - "class: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: class") - (test-expression "shared" - "shared: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: shared") - - (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") - (test-expression "'(1 . 2)" "read: illegal use of \".\"") - - (test-expression "call/cc" - "call/cc: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "a: ~a1") - (test-expression "(error \"a\" \"a\")" "aa") - - (test-expression "(time 1)" - "time: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: time") - - (test-expression "true" - "true" - "true") - (test-expression "mred^" - "mred^: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: mred^") - (test-expression "(eq? 'a 'A)" - "false" - "false") - (test-expression "(set! x 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(define qqq 2) (set! qqq 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") - (test-expression "(cons 1 2)" "cons: second argument must be of type , given 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") - (test-expression "'(1)" - "(list 1)" - "(list 1)") - (test-expression "(define shrd (list 1)) (list shrd shrd)" - "(list (list 1) (list 1))" - "define: cannot redefine name: shrd\n(list (list 1) (list 1))") - (test-expression "(local ((define x x)) 1)" - "local: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression "(letrec ([x x]) 1)" - "letrec: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "procedure +: expects at least 2 arguments, given 1: 1") - - (test-expression "1.0" "1" "1") - (test-expression "#i1.0" "#i1.0" "#i1.0") - (test-expression "4/3" - "{number 4/3 \"1.3\" decimal}" - "{number 4/3 \"1.3\" decimal}") - (test-expression "1/3" - "{number 1/3 \"0.3\" decimal}" - "{number 1/3 \"0.3\" decimal}") - (test-expression "-4/3" - "{number -4/3 \"-1.3\" decimal}" - "{number -4/3 \"-1.3\" decimal}") - (test-expression "-1/3" - "{number -1/3 \"-0.3\" decimal}" - "{number -1/3 \"-0.3\" decimal}") - (test-expression "3/2" - "{number 3/2 \"1.5\" decimal}" - "{number 3/2 \"1.5\" decimal}") - (test-expression "1/2" - "{number 1/2 \"0.5\" decimal}" - "{number 1/2 \"0.5\" decimal}") - (test-expression "-1/2" - "{number -1/2 \"-0.5\" decimal}" - "{number -1/2 \"-0.5\" decimal}") - (test-expression "-3/2" - "{number -3/2 \"-1.5\" decimal}" - "{number -3/2 \"-1.5\" decimal}") - (test-expression "+1/3i" - "0+1/3i" - "0+1/3i") - (test-expression "+1/2i" - "0+0.5i" - "0+0.5i") - (test-expression "779625/32258" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" "true") - (test-expression "(print (floor (sqrt 2)))" - "print: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: print") - - (test-expression "(let ([f (lambda (x) x)]) f)" - "let: name is not defined, not a parameter, and not a primitive name" - "function call: expected a defined function name or a primitive operation name after an open parenthesis, but found something else") - (test-expression ",1" - "unquote: misuse of a comma or `unquote', not under a quasiquoting backquote") - - (test-expression "(list 1)" - "(list 1)" - "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") - - (test-expression "argv" - "argv: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: argv") - - (test-expression "(define-syntax app syntax-case)" - "define-syntax: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: define-syntax") - - (test-expression "#lang racket" - "module: name is not defined, not a parameter, and not a primitive name" - "read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "define: expected at least one argument name after the function name, but found none" - #rx"define: function definitions are not allowed in the interactions window"))) - - -; -; ;; ;;; ;; -; ;; ;; ;; ;; ;; -; ;; ;; ;; -; ;;; ;;; ;; ;;;;; ;;;; ;;; ;; ;;; ;; ;; ;;;; ;;;;; ;;; ;;;; ;;;;; ;;;; -; ;; ;;; ;; ;; ;; ;; ;;;;; ;;; ;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; -; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; -; ;; ;; ;; ;; ;;;;;; ;; ;; ;; ;; ;;;;;; ;; ;; ;; ;;;;; ;; ;;;;;; -; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; -; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; ; -; ;;;; ;;;; ;;; ;;; ;;;; ;;;; ;;;; ;;; ;;; ;;;; ;;;;;; ;;;; ;;;;;; ;;; ;;;; -; -; -; - - -(define (intermediate) - (parameterize ([language (list "How to Design Programs" #rx"Intermediate Student(;|$)")]) - (check-top-of-repl) - - (generic-settings #t) - (generic-output #t #f #f #f) - (teaching-language-fraction-output) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" - "'|.|" - "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "true" - "true") - - (test-expression "(define x 1)(define x 2)" - "x: this name was defined previously and cannot be re-defined" - "define: cannot redefine name: x") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "(make-spider 4)" - "define-struct: cannot redefine name: spider\n(make-spider 4)") - - (test-expression "(sqrt -1)" - "0+1i" - "0+1i") - - (test-expression "class" - "class: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: class") - (test-expression "shared" - "shared: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: shared") - - (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") - (test-expression "'(1 . 2)" "read: illegal use of \".\"") - - (test-expression "call/cc" - "call/cc: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "a: ~a1") - (test-expression "(error \"a\" \"a\")" "aa") - - (test-expression "(time 1)" - #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") - - (test-expression "true" - "true" - "true") - (test-expression "mred^" - "mred^: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: mred^") - (test-expression "(eq? 'a 'A)" - "false" - "false") - (test-expression "(set! x 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(define qqq 2) (set! qqq 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") - (test-expression "(cons 1 2)" "cons: second argument must be of type , given 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") - (test-expression "'(1)" - "(list 1)" - "(list 1)") - (test-expression "(define shrd (list 1)) (list shrd shrd)" - "(list (list 1) (list 1))" - "define: cannot redefine name: shrd\n(list (list 1) (list 1))") - (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") - (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") - (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1" "1") - (test-expression "#i1.0" "#i1.0" "#i1.0") - (test-expression "4/3" - "{number 4/3 \"1.3\" decimal}" - "{number 4/3 \"1.3\" decimal}") - (test-expression "1/3" - "{number 1/3 \"0.3\" decimal}" - "{number 1/3 \"0.3\" decimal}") - (test-expression "-4/3" - "{number -4/3 \"-1.3\" decimal}" - "{number -4/3 \"-1.3\" decimal}") - (test-expression "-1/3" - "{number -1/3 \"-0.3\" decimal}" - "{number -1/3 \"-0.3\" decimal}") - (test-expression "3/2" - "{number 3/2 \"1.5\" decimal}" - "{number 3/2 \"1.5\" decimal}") - (test-expression "1/2" - "{number 1/2 \"0.5\" decimal}" - "{number 1/2 \"0.5\" decimal}") - (test-expression "-1/2" - "{number -1/2 \"-0.5\" decimal}" - "{number -1/2 \"-0.5\" decimal}") - (test-expression "-3/2" - "{number -3/2 \"-1.5\" decimal}" - "{number -3/2 \"-1.5\" decimal}") - (test-expression "+1/3i" - "0+1/3i" - "0+1/3i") - (test-expression "+1/2i" - "0+0.5i" - "0+0.5i") - (test-expression "779625/32258" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" "true") - (test-expression "(print (floor (sqrt 2)))" - "print: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: print") - - (test-expression "(let ([f (lambda (x) x)]) f)" - "function:f" - "function:f") - (test-expression ",1" - "unquote: misuse of a comma or `unquote', not under a quasiquoting backquote") - - (test-expression "(list 1)" - "(list 1)" - "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") - (test-expression "argv" - "argv: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: argv") - - (test-expression "(define-syntax app syntax-case)" - "define-syntax: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: define-syntax") - - (test-expression "#lang racket" - "module: name is not defined, not a parameter, and not a primitive name" - "read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "define: expected at least one argument name after the function name, but found none" - #rx"define: expected at least one argument name after the function name, but found none"))) - - - -; -; -; -; ;; ; ;;;;;; ;;;; ;;;; -; ;; ;; ;;;;;; ;;;; ;;;; -; ;;;; ;;; ;;;;; ;;;;;; ;;;;;;; ;;;;;;; ;;;; ;;;;;;; ;;;;;;; ;;;;;;; -; ;;;; ;;;;;;;;; ;;;;;; ;;;;;; ;;;;;;;; ;;;;;;;;;;;;; ;;;;;;;; ;;;;;;;; ;;;;;;;; -; ;;;; ;;;; ;;;; ;;;; ;;;;;; ;;;; ;;;; ;;; ;;;; ;;;;;;;;; ;;;;;;;;; ;;;; -; ;;;; ;;;; ;;;; ;;;; ;; ;;;; ;;;;;;; ;;;; ;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;;;;; -; ;;;; ;;;; ;;;; ;;;;; ;; ;;;; ;; ;;;; ;;;; ;;; ;;;; ;;;;;;;;; ;;;;;;;;; ;; ;;;; -; ;;;; ;;;; ;;;; ;;;;; ;; ;;;; ;;;;;;;; ;;;; ;;; ;;;; ;;;;;;;; ;;;;;;;; ;;;;;;;; -; ;;;; ;;;; ;;;; ;;;; ;; ;;;; ;; ;;;; ;;;; ;;; ;;;; ;;;;;;; ;;;;;;; ;; ;;;; -; ;; -; -; - - -(define (intermediate/lambda) - (parameterize ([language (list "How to Design Programs" - #rx"Intermediate Student with lambda(;|$)")]) - (check-top-of-repl) - - (generic-settings #t) - (generic-output #t #f #f #f) - (teaching-language-fraction-output) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" - "'|.|" - "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "true" - "true") - (test-expression "(define x 1)(define x 2)" - "x: this name was defined previously and cannot be re-defined" - "define: cannot redefine name: x") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "(make-spider 4)" - "define-struct: cannot redefine name: spider\n(make-spider 4)") - - (test-expression "(sqrt -1)" - "0+1i" - "0+1i") - - (test-expression "class" - "class: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: class") - (test-expression "shared" - "shared: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: shared") - - (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") - (test-expression "'(1 . 2)" "read: illegal use of \".\"") - - (test-expression "call/cc" - "call/cc: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "a: ~a1") - (test-expression "(error \"a\" \"a\")" "aa") - - (test-expression "(time 1)" - #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") - - (test-expression "true" - "true" - "true") - (test-expression "mred^" - "mred^: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: mred^") - (test-expression "(eq? 'a 'A)" - "false" - "false") - (test-expression "(set! x 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(define qqq 2) (set! qqq 1)" - "set!: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: set!") - (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") - (test-expression "(cons 1 2)" "cons: second argument must be of type , given 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") - (test-expression "'(1)" - "(list 1)" - "(list 1)") - (test-expression "(define shrd (list 1)) (list shrd shrd)" - "(list (list 1) (list 1))" - "define: cannot redefine name: shrd\n(list (list 1) (list 1))") - (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") - (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") - (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1" "1") - (test-expression "#i1.0" "#i1.0" "#i1.0") - (test-expression "4/3" - "{number 4/3 \"1.3\" decimal}" - "{number 4/3 \"1.3\" decimal}") - (test-expression "1/3" - "{number 1/3 \"0.3\" decimal}" - "{number 1/3 \"0.3\" decimal}") - (test-expression "-4/3" - "{number -4/3 \"-1.3\" decimal}" - "{number -4/3 \"-1.3\" decimal}") - (test-expression "-1/3" - "{number -1/3 \"-0.3\" decimal}" - "{number -1/3 \"-0.3\" decimal}") - (test-expression "3/2" - "{number 3/2 \"1.5\" decimal}" - "{number 3/2 \"1.5\" decimal}") - (test-expression "1/2" - "{number 1/2 \"0.5\" decimal}" - "{number 1/2 \"0.5\" decimal}") - (test-expression "-1/2" - "{number -1/2 \"-0.5\" decimal}" - "{number -1/2 \"-0.5\" decimal}") - (test-expression "-3/2" - "{number -3/2 \"-1.5\" decimal}" - "{number -3/2 \"-1.5\" decimal}") - (test-expression "+1/3i" "0+1/3i" "0+1/3i") - (test-expression "+1/2i" "0+0.5i" "0+0.5i") - (test-expression "779625/32258" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" "true") - (test-expression "(print (floor (sqrt 2)))" - "print: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: print") - - (test-expression "(let ([f (lambda (x) x)]) f)" - "(lambda (a1) ...)" - "(lambda (a1) ...)") - (test-expression ",1" - "unquote: misuse of a comma or `unquote', not under a quasiquoting backquote") - - (test-expression "(list 1)" - "(list 1)" - "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") - (test-expression "argv" - "argv: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: argv") - - (test-expression "(define-syntax app syntax-case)" - "define-syntax: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: define-syntax") - - (test-expression "#lang racket" - "module: name is not defined, not a parameter, and not a primitive name" - "read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - "define: expected at least one argument name after the function name, but found none" - #rx"define: expected at least one argument name after the function name, but found none"))) - - - -; -; -; -; ;;;; ;;;; -; ;;;; ;;;; -; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;; ;;; ;;;;; ;;; ;;;;;;; -; ;;;;;;;; ;;;;;;;; ;;; ;;; ;;;;;;;; ;;;;;;;;; ;;;;;; ;;;;; ;;;;;;;; -; ;;;; ;;;;;;;;; ;;;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;; ;;;;;;;;; -; ;;;;;;; ;;;; ;;;; ;;;;;; ;;;;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;; -; ;; ;;;; ;;;;;;;;; ;;;;;; ;; ;;;; ;;;; ;;;; ;;;;;;; ;;;;; ;;;;;;;;; -; ;;;;;;;; ;;;;;;;; ;;;; ;;;;;;;; ;;;; ;;;; ;;;;;; ;;;;;; ;;;;;;;; -; ;; ;;;; ;;;;;;; ;;;; ;; ;;;; ;;;; ;;;; ;;;;; ;;;; ;;;;;;; -; -; -; - - -(define (advanced) - (parameterize ([language (list "How to Design Programs" #rx"Advanced Student(;|$)")]) - (check-top-of-repl) - - (generic-settings #t) - (generic-output #t #t #t #f) - (teaching-language-fraction-output) - - (test-hash-bang) - (test-error-after-definition) - - (prepare-for-test-expression) - - (test-expression "'|.|" - "'|.|" - "'|.|") - (test-expression '("(equal? (list " image ") (list " image "))") - "true" - "true") - (test-expression "(define x 1)(define x 2)" - "x: this name was defined previously and cannot be re-defined" - "define: cannot redefine name: x") - - (test-expression "(define-struct spider (legs))(make-spider 4)" - "(make-spider 4)" - "define-struct: cannot redefine name: spider\n(make-spider 4)") - - (test-expression "(sqrt -1)" - "0+1i" - "0+1i") - - (test-expression "class" - "class: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: class") - - (test-expression "shared" "shared: found a use of `shared' that does not follow an open parenthesis") - - (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") - (test-expression "'(1 . 2)" "read: illegal use of \".\"") - - (test-expression "call/cc" - "call/cc: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: call/cc") - - (test-expression "(error 'a \"~a\" 1)" "a: ~a1") - (test-expression "(error \"a\" \"a\")" "aa") - - (test-expression "(time 1)" - #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") - - (test-expression "true" - "true" - "true") - (test-expression "mred^" - "mred^: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: mred^") - (test-expression "(eq? 'a 'A)" - "false" - "false") - (test-expression "(set! x 1)" - "x: name is not defined" - "set!: cannot set variable before its definition: x") - (test-expression "(define qqq 2) (set! qqq 1)" - "(void)" - "define: cannot redefine name: qqq\n(void)") - (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") - (test-expression "(cons 1 2)" "cons: second argument must be of type , given 1 and 2") - (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") - (test-expression "'(1)" - "(list 1)" - "(list 1)") - (test-expression "(define shrd (list 1)) (list shrd shrd)" - "(shared ((-1- (list 1))) (list -1- -1-))" - "define: cannot redefine name: shrd\n(shared ((-1- (list 1))) (list -1- -1-))") - (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") - (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") - (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") - (test-expression "(+ 1)" "1") - - (test-expression "1.0" "1" "1") - (test-expression "#i1.0" "#i1.0" "#i1.0") - (test-expression "4/3" - "{number 4/3 \"1.3\" decimal}" - "{number 4/3 \"1.3\" decimal}") - (test-expression "1/3" - "{number 1/3 \"0.3\" decimal}" - "{number 1/3 \"0.3\" decimal}") - (test-expression "-4/3" - "{number -4/3 \"-1.3\" decimal}" - "{number -4/3 \"-1.3\" decimal}") - (test-expression "-1/3" - "{number -1/3 \"-0.3\" decimal}" - "{number -1/3 \"-0.3\" decimal}") - (test-expression "3/2" - "{number 3/2 \"1.5\" decimal}" - "{number 3/2 \"1.5\" decimal}") - (test-expression "1/2" - "{number 1/2 \"0.5\" decimal}" - "{number 1/2 \"0.5\" decimal}") - (test-expression "-1/2" - "{number -1/2 \"-0.5\" decimal}" - "{number -1/2 \"-0.5\" decimal}") - (test-expression "-3/2" - "{number -3/2 \"-1.5\" decimal}" - "{number -3/2 \"-1.5\" decimal}") - (test-expression "+1/3i" - "0+1/3i" - "0+1/3i") - (test-expression "+1/2i" - "0+0.5i" - "0+0.5i") - (test-expression "779625/32258" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" - "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" "true") - (test-expression "(print (floor (sqrt 2)))" "#i1.0") - - (test-expression "(let ([f (lambda (x) x)]) f)" - "(lambda (a1) ...)" - "(lambda (a1) ...)") - (test-expression ",1" - "unquote: misuse of a comma or `unquote', not under a quasiquoting backquote") - - (test-expression "(list 1)" - "(list 1)" - "(list 1)") - (test-expression "(car (list))" "car: expects argument of type ; given empty") - (test-expression "argv" - "argv: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: argv") - - (test-expression "(define-syntax app syntax-case)" - "define-syntax: name is not defined, not a parameter, and not a primitive name" - "reference to an identifier before its definition: define-syntax") - - (test-expression "#lang racket" - "module: name is not defined, not a parameter, and not a primitive name" - "read: #lang not enabled in the current context") - (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" - #rx"raise-user-error" - #rx"raise-user-error"))) - - - - -(define (prepare-for-test-expression) - (let ([drs (wait-for-drscheme-frame)]) - (clear-definitions drs) - (set-language #t) - (sleep 1) ;; this shouldn't be neccessary.... - (do-execute drs))) - -;; test-setting : (-> void) string string string -> void -;; opens the language dialog, runs `set-setting' -;; closes the language dialog, executes, -;; makes sure that `expression' produces -;; `result'. `set-setting' is expected to click around -;; in the language dialog. -;; `setting-name' is used in the error message when the test fails. -(define (test-setting set-setting setting-name expression result) - (set-language #f) - (set-setting) - (let ([f (get-top-level-focus-window)]) - (fw:test:button-push "OK") - (wait-for-new-frame f)) - (let* ([drs (get-top-level-focus-window)] - [interactions (send drs get-interactions-text)]) - (clear-definitions drs) - (type-in-definitions drs expression) - (do-execute drs) - (let* ([got (fetch-output/should-be-tested drs)]) - (unless (string=? result got) - (fprintf (current-error-port) - "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n" - (language) setting-name expression result got))))) - -(define (test-hash-bang) - (let* ([expression "#!/bin/sh\n1"] - [result "1"] - [drs (get-top-level-focus-window)] - [interactions (queue-callback (λ () (send drs get-interactions-text)))]) - (clear-definitions drs) - (type-in-definitions drs expression) - (do-execute drs) - (let* ([got (fetch-output/should-be-tested drs)]) - (unless (string=? "1" got) - (fprintf (current-error-port) - "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n" - (language) expression result got))))) - -(define (fetch-output/should-be-tested . args) - (regexp-replace (regexp - (string-append - (regexp-quote "") - "$")) - (apply fetch-output args) - "")) - -(define (check-top-of-repl) - (let ([drs (wait-for-drscheme-frame)]) - (set-language #t) - (with-handlers ([exn:fail? void]) - (fw:test:menu-select "Testing" "Disable tests")) - (do-execute drs) - (let* ([interactions (send drs get-interactions-text)] - [short-lang (last (language))] - [get-line (lambda (n) - (queue-callback/res - (λ () - (send interactions get-text - (send interactions paragraph-start-position n) - (send interactions paragraph-end-position n)))))] - [line0-expect (format "Welcome to DrRacket, version ~a [~a]." - (version:version) - (system-type 'gc))] - [line1-expect - (if (string? short-lang) - (format "Language: ~a" short-lang) - short-lang)] - [line0-got (get-line 0)] - [line1-got (get-line 1)]) - (unless (and (string=? line0-expect line0-got) - (if (string? short-lang) - (string=? line1-expect (substring line1-got - 0 - (min (string-length line1-expect) - (string-length line1-got)))) - (regexp-match line1-expect line1-got))) - (fprintf (current-error-port) - "expected lines: \n ~a\n ~a\ngot lines:\n ~a\n ~a\n" - line0-expect line1-expect - line0-got line1-got) - (error 'language-test.rkt "failed get top of repl test"))))) - - -;; teaching-language-fraction-output -;; tests that the teaching languages properly handle repeating decimals -(define (teaching-language-fraction-output) - (test-setting - (lambda () (fw:test:set-radio-box! "Fraction Style" "Mixed fractions")) - "Fraction Style -- Mixed fractions" - "4/3" - "{number 4/3 \"1 1/3\" mixed}") - (test-setting - (lambda () (fw:test:set-radio-box! "Fraction Style" "Repeating decimals")) - "Fraction Style -- Repeating decimals" - "4/3" - "{number 4/3 \"1.3\" decimal}")) - -;; plt-language-fraction-output : -> void -;; tests that the PLT languages properly handle repeating decimals -(define (plt-language-fraction-output) - (test-setting - (lambda () (fw:test:set-check-box! "Use decimal notation for rationals" #f)) - "Use decimal notation for rationals -- #f" - "4/3 1/2 -1/3" - "{number 4/3 \"1 1/3\" mixed}\n{number 1/2 \"1/2\" mixed}\n{number -1/3 \"- 1/3\" mixed}") - (test-setting - (lambda () (fw:test:set-check-box! "Use decimal notation for rationals" #t)) - "Use decimal notation for rationals -- #t" - "4/3 1/2 -1/3" - "{number 4/3 \"#e1.3\" decimal}\n{number 1/2 \"#e0.5\" decimal}\n{number -1/3 \"#e-0.3\" decimal}")) - -(define (generic-settings false/true?) - (test-setting - (lambda () (fw:test:set-check-box! "Case sensitive" #t)) - "Case sensitive -- #t" - "(eq? 'g 'G)" - (if false/true? "false" "#f")) - (test-setting - (lambda () (fw:test:set-check-box! "Case sensitive" #f)) - "Case sensitive -- #f" - "(eq? 'g 'G)" - (if false/true? "true" "#t"))) - -(define (generic-output list? quasi-quote? has-sharing? has-print-printing?) - (let* ([plain-print-style (if has-print-printing? "print" "write")] - [drs (wait-for-drscheme-frame)] - [expression "(define x (list 2))\n(list x x)"] - [set-output-choice - (lambda (option show-sharing pretty?) - (set-language #f) - (fw:test:set-radio-box! "Output Style" option) - (when (and has-sharing? show-sharing) - (fw:test:set-check-box! - "Show sharing in values" - (if (eq? show-sharing 'on) #t #f))) - (fw:test:set-check-box! - "Insert newlines in printed values" - pretty?) - (let ([f (get-top-level-focus-window)]) - (fw:test:button-push "OK") - (wait-for-new-frame f)))] - [shorten - (lambda (str) - (if ((string-length str) . <= . 45) - str - (string-append (substring str 0 45) "...")))] - [test - ;; answer must either be a string, or a procedure that accepts both zero and 1 - ;; argument. When the procedure accepts 1 arg, the argument is `got' and - ;; the result must be a boolean indicating if the result was satisfactory. - ;; if the procedure receives no arguments, it must return a descriptive string - ;; for the error message - (lambda (option show-sharing pretty? answer) - (set-output-choice option show-sharing pretty?) - (do-execute drs) - (let ([got (fetch-output/should-be-tested drs)]) - (unless (if (procedure? answer) - (answer got) - (whitespace-string=? answer got)) - (fprintf (current-error-port) - "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n" - (language) option show-sharing pretty? - (shorten got) - (if (procedure? answer) (answer) answer)))))]) - - (clear-definitions drs) - (type-in-definitions drs expression) - - (test plain-print-style 'off #t "((2) (2))") - (when has-sharing? - (test plain-print-style 'on #t "(#0=(2) #0#)")) - (when quasi-quote? - (test "Quasiquote" 'off #t "`((2) (2))") - (when has-sharing? - (test "Quasiquote" 'on #t "(shared ((-1- `(2))) `(,-1- ,-1-))"))) - - (test "Constructor" 'off #t - (if list? - "(list (list 2) (list 2))" - "(cons (cons 2 empty) (cons (cons 2 empty) empty))")) - (when has-sharing? - (test "Constructor" 'on #t - (if list? - "(shared ((-1- (list 2))) (list -1- -1-))" - "(shared ((-1- (cons 2 empty))) (cons -1- (cons -1- empty)))"))) - - ;; setup print / pretty-print difference - (clear-definitions drs) - (for-each fw:test:keystroke - (string->list - "(define (f n)\n(cond ((zero? n) (list))\n(else (cons n (f (- n 1))))))\n(f 200)")) - (test "Constructor" #f #f - (case-lambda - [(x) (not (member #\newline (string->list x)))] - [() "no newlines in result"])) - (test "Constructor" #f #t - (case-lambda - [(x) (member #\newline (string->list x))] - [() "newlines in result (may need to make the window smaller)"])) - (test plain-print-style #f #f - (case-lambda - [(x) (not (member #\newline (string->list x)))] - [() "no newlines in result"])) - (test plain-print-style #f #t - (case-lambda - [(x) (member #\newline (string->list x))] - [() "newlines in result (may need to make the window smaller)"])))) - -(define re:out-of-sync - (regexp - "WARNING: Interactions window is out of sync with the definitions window\\.")) - -(define (test-error-after-definition) - (let* ([drs (wait-for-drscheme-frame)] - [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))]) - (clear-definitions drs) - (type-in-definitions drs "(define y 0) (define (f x) (/ x y)) (f 2)") - (do-execute drs) - (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) - (type-in-interactions drs "y\n") - (wait-for-computation drs) - (let ([got - (fetch-output/should-be-tested - drs - (queue-callback/res (λ () (send interactions-text paragraph-start-position (+ last-para 1)))) - (queue-callback/res - (λ () - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))))]) - (unless (equal? got "0") - (fprintf (current-error-port) - "FAILED: test-error-after-definition failed, expected 0, got ~s\n" got)))))) - - -;; test-expression : (union string 'xml 'image (listof (union string 'xml 'image))) -;; (union string regexp (string -> boolean)) -;; -> void -;; types an expression in the definitions window, executes it and tests the output -;; types an expression in the REPL and tests the output from the REPL. -(define (test-expression expression defs-expected [repl-expected defs-expected]) - (let* ([drs (wait-for-drscheme-frame)] - [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))] - [definitions-text (queue-callback/res (λ () (send drs get-definitions-text)))] - [handle-insertion - (lambda (item) - (cond - [(eq? item 'image) - (use-get/put-dialog - (lambda () (fw:test:menu-select "Insert" "Insert Image...")) - (simplify-path (build-path (collection-path "icons") "recycle.png")))] - [(string? item) - (insert-in-definitions drs item)] - [(eq? item 'xml) - (fw:test:menu-select "Insert" "Insert XML Box") - (for-each fw:test:keystroke (string->list ""))] - [else (error 'handle-insertion "unknown thing to insert ~s" item)]))] - [check-expectation - (lambda (expected got) - (cond - [(string? expected) - (whitespace-string=? expected got)] - [(regexp? expected) - (regexp-match expected got)] - [(procedure? expected) - (expected got)]))] - [make-err-msg - (lambda (expected) - (cond - [(string? expected) - "FAILED: ~s ~s expected ~s to produce:\n ~s\ngot:\n ~s\ninstead\n"] - [(regexp? expected) - "FAILED: ~s ~s expected ~s to match ~s, got ~s instead\n"] - [(procedure? expected) - "FAILED: ~s ~s expected ~s to pass predicate ~s, got ~s\n"]))]) - (clear-definitions drs) - (insert-in-definitions drs (defs-prefix)) - (cond - [(pair? expression) (for-each handle-insertion expression)] - [else (handle-insertion expression)]) - (do-execute drs) - - (let ([got - (fetch-output - drs - (queue-callback/res (λ () (send interactions-text paragraph-start-position 2))) - (queue-callback/res - (λ () - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))))]) - (when (regexp-match re:out-of-sync got) - (error 'text-expression "got out of sync message")) - (unless (check-expectation defs-expected got) - (fprintf (current-error-port) - (make-err-msg defs-expected) - 'definitions (language) expression defs-expected got))) - - (let ([dp (defs-prefix)]) - (queue-callback/res - (λ () - ;; select all except the defs-prefix - (send definitions-text set-position - (string-length dp) - (send definitions-text last-position)) - - (send definitions-text copy) - (send interactions-text set-position - (send interactions-text last-position) - (send interactions-text last-position)) - (send interactions-text paste)))) - - (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) - (alt-return-in-interactions drs) - (wait-for-computation drs) - (let ([got - (fetch-output - drs - (queue-callback/res - (λ () - (send interactions-text paragraph-start-position (+ last-para 1)))) - (queue-callback/res - (λ () - (send interactions-text paragraph-end-position - (- (send interactions-text last-paragraph) 1)))))]) - (when (regexp-match re:out-of-sync got) - (error 'text-expression "got out of sync message")) - (unless (check-expectation repl-expected got) - (fprintf (current-error-port) - (make-err-msg repl-expected) - 'interactions - (language) - expression repl-expected got)))))) - - -(define-syntax (go stx) - (syntax-case stx () - [(_ arg) - (identifier? (syntax arg)) - (syntax (begin (flush-output) - (printf ">> starting ~a\n" 'arg) - (flush-output) - (arg) - (flush-output) - (printf ">> finished ~a\n" 'arg) - (flush-output)))])) - -(define (run-test) - (go module-lang) - (go pretty-big) - (go r5rs) - (go beginner) - (go beginner/abbrev) - (go intermediate) - (go intermediate/lambda) - (go advanced)) - -(fire-up-drscheme-and-run-tests run-test) +#lang scheme + +#| + +Make sure there are tests that cover these parameters: + + (read-case-sensitive #f) + (read-square-bracket-as-paren #f) -- test: (symbol? '[]) + (read-curly-brace-as-paren #f) + (print-vector-length #f) + +the settings above should match r5rs + +|# + + +(require "drracket-test-util.rkt" + tests/utils/gui + mred + framework + (prefix-in fw: framework)) + +(define language (make-parameter "<>")) +(define defs-prefix (make-parameter "")) + +;; set-language : boolean -> void +(define (set-language close-dialog?) + (if (eq? (car (language)) 'module) + (set-module-language! close-dialog?) + (set-language-level! (language) close-dialog?))) + + +; +; +; +; +; ;; ;; +; ;; ;; +; ;;;;; ;; ;;; ;;;;; ;; ;; ;; ;;;; +; ;;;;;;;;; ;;;;; ;;;;; ;; ;; ;; ;; ;;; +; ;; ;; ;; ;;; ;;;;; ;; ;; ;; ;; ;;;;;;; +; ;; ;; ;; ;;; ;;;;; ;; ;; ;; ;; ;;; +; ;; ;; ;; ;;;;; ;;;;; ;;;;; ;; ;; ;; +; ;; ;; ;; ;;; ;;;;; ;;;;; ;; ;;;; +; +; +; +; + +(define (module-lang) + (parameterize ([language '(module "racket")] + [defs-prefix "#lang racket\n"]) + + (check-top-of-repl) + + (prepare-for-test-expression) + + (test-expression "'|.|" "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "#t") + (test-expression "(define x 1)(define x 2)" #rx"duplicate definition for identifier in: x" "") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "#" + "define-values: cannot re-define a constant: struct:spider\n#") + + (test-expression "(sqrt -1)" "0+1i") + + (test-expression "class" (regexp "class: bad syntax in: class")) + (test-expression "shared" (regexp "shared: bad syntax in: shared")) + + (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"" "") + (test-expression "'(1 . 2)" "'(1 . 2)") + + (test-expression "(define (f define) 1)" "" "define-values: cannot re-define a constant: f") + (test-expression "(define (f car) 1)" "" "define-values: cannot re-define a constant: f") + (test-expression "(define (f empty) 1)" "" "define-values: cannot re-define a constant: f") + + (test-expression "call/cc" "#") + + (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} a: 1") + (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} a \"a\"") + + (test-expression "(time 1)" + #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") + + (test-expression "true" "#t") + (test-expression "mred^" + #rx"unbound identifier in module in: mred\\^" + #rx"reference to undefined identifier: mred\\^") + (test-expression "(eq? 'a 'A)" "#f") + (test-expression "(set! x 1)" + #rx"set!: unbound identifier in module in: x" + #rx"set!: cannot set undefined variable: x") + (test-expression "(define qqq 2) (set! qqq 1)" "") + (test-expression "(cond [(= 1 2) 3])" "") + (test-expression "(cons 1 2)" "'(1 . 2)") + (test-expression "(+ (list 1) 2)" (regexp (regexp-quote "+: expects type as 1st argument, given: '(1); other arguments were: 2"))) + (test-expression "'(1)" "'(1)") + (test-expression "(define shrd (box 1)) (list shrd shrd)" + "'(#&1 #&1)" + "define-values: cannot re-define a constant: shrd\n'(#&1 #&1)") + (test-expression "(local ((define x x)) 1)" "1") + (test-expression "(letrec ([x x]) 1)" "1") + (test-expression "(if 1 1 1)" "1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1.0") + (test-expression "#i1.0" "1.0") + (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") + (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") + (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") + (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") + (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") + (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") + (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") + (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") + (test-expression "+1/3i" "0+1/3i") + (test-expression "+1/2i" "0+1/2i") + (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") + (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" "1.0") + + (test-expression "(let ([f (lambda (x) x)]) f)" "#") + (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") + + (test-expression "(list 1)" "'(1)") + (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type ; given '()") + + (test-expression "(current-command-line-arguments)" "'#()") + (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") + + (test-expression "#lang racket" #rx"module: illegal use \\(not at top-level\\)" #rx"read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "a: b"))) + + +; +; +; +; ; ; ;;;; ;; +; ;; ;; ;;;; ;; +; ;;;;;;; ;;; ;;; ;;; ;;;;; ;;;;; ;;; ;;; ;;;;;;; ;;;;;;; +; ;;;;;;;; ;;;;;;; ;;;;; ;;;;;; ;;;;;; ;;; ;;;; ;;;;;;;; ;;;; ;;;;;;;; +; ;;;;;;;;; ;;;; ;; ;;;; ;; ;;;; ;;;; ;;;;;; ;;;;;;;;; ;;;; ;;; ;;;; +; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;; ;;;;;; ;;;; ;;;; ;;;; ;;;;;;;; +; ;;;;;;;;; ;;;; ;;;;; ;;;;; ;;;;; ;;;;; ;;;;;;;;; ;;;; ;;;;;;; +; ;;;;;;;; ;;;; ;;;;;; ;;;;; ;;;;; ;;;; ;;;;;;;; ;;;; ; ;;;; +; ;;;;;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;;;;;; +; ;;;; ;;;; ;;;;;;;; +; ;;;; ;;;; ;;;;;; +; + +(define (pretty-big) + (parameterize ([language (list #rx"Pretty Big")]) + + (check-top-of-repl) + + (generic-settings #f) + (generic-output #t #t #t #t) + + (test-hash-bang) + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" "|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "#t") + (test-expression "(define x 1)(define x 2)" "") + + (test-expression "(define-struct spider (legs))(make-spider 4)" "#") + + (test-expression "(sqrt -1)" "0+1i") + + (test-expression "class" (regexp "class: bad syntax in: class")) + (test-expression "shared" (regexp "shared: bad syntax in: shared")) + + (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"") + (test-expression "'(1 . 2)" "(1 . 2)") + + (test-expression "(define (f define) 1)" "") + (test-expression "(define (f car) 1)" "") + (test-expression "(define (f empty) 1)" "") + + (test-expression "call/cc" "#") + + (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} a: 1") + (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} a \"a\"") + + (test-expression "(time 1)" + #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") + + (test-expression "true" "#t") + (test-expression "mred^" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: mred^") + (test-expression "(eq? 'a 'A)" "#f") + (test-expression "(set! x 1)" "{stop-multi.png} {stop-22x22.png} set!: cannot set undefined variable: x") + (test-expression "(define qqq 2) (set! qqq 1)" "") + (test-expression "(cond [(= 1 2) 3])" "") + (test-expression "(cons 1 2)" "(1 . 2)") + (test-expression "(+ (list 1) 2)" "{stop-multi.png} {stop-22x22.png} +: expects type as 1st argument, given: (1); other arguments were: 2") + (test-expression "'(1)" "(1)") + (test-expression "(define shrd (box 1)) (list shrd shrd)" + "(#&1 #&1)") + (test-expression "(local ((define x x)) 1)" "1") + (test-expression "(letrec ([x x]) 1)" "1") + (test-expression "(if 1 1 1)" "1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1.0") + (test-expression "#i1.0" "1.0") + (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") + (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") + (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") + (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") + (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") + (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") + (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") + (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") + (test-expression "+1/3i" "0+1/3i") + (test-expression "+1/2i" "0+1/2i") + (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") + (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" "1.0") + + (test-expression "(let ([f (lambda (x) x)]) f)" "#") + (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") + + (test-expression "(list 1)" "(1)") + (test-expression "(car (list))" "{stop-multi.png} {stop-22x22.png} car: expects argument of type ; given ()") + + (test-expression "(current-command-line-arguments)" "#()") + (test-expression "(define-syntax app syntax-case)" "{stop-22x22.png} syntax-case: bad syntax in: syntax-case") + + (test-expression "#lang racket" + "" + #rx"read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "a: b"))) + +; +; +; ;;;;;;; ;;;;;;; ;;;;;; +; ;; ;; ;; ;; ;; ;; +; ;; ;; ;;;;; ;; ;; ;; ; +; ;; ;; ;;;;; ;; ;; ;;;; +; ;;;;;; ; ;;;;;; ;;;;; +; ;; ;; ;;;; ;; ;; ;;; +; ;; ;; ;; ;; ;; ; ;; +; ;; ;; ;; ;; ;; ;; ;; +; ;;;; ;;; ;; ;; ;;;; ;;;;;;;;; +; ;; ;; +; ;;;; +; + + +(define (r5rs) + (parameterize ([language (list (regexp "R5RS"))]) + + (check-top-of-repl) + + (generic-settings #f) + (generic-output #t #t #t #t) + + (test-hash-bang) + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" "|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "#t") + (test-expression "(define x 1)(define x 2)" "") + + (test-expression + "(define-struct spider (legs))(make-spider 4)" + "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: define-struct" + "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: define-struct\n{stop-multi.png} {stop-22x22.png} reference to undefined identifier: make-spider") + + (test-expression "(sqrt -1)" "0+1i") + + (test-expression "class" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: class") + (test-expression "shared" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: shared") + + (test-expression "(define (. x y) (* x y))" #rx"read: illegal use of \"\\.\"") + (test-expression "'(1 . 2)" "(1 . 2)") + + (test-expression "(define (f define) 1)" "") + (test-expression "(define (f car) 1)" "") + (test-expression "(define (f empty) 1)" "") + + (test-expression "call/cc" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: call/cc") + + (test-expression "(error 'a \"~a\" 1)" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: error") + (test-expression "(error \"a\" \"a\")" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: error") + + (test-expression "(time 1)" + "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: time") + + (test-expression "true" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: true") + (test-expression "mred^" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: mred^") + (test-expression "(eq? 'a 'A)" "#t") + (test-expression "(set! x 1)" "{stop-multi.png} {stop-22x22.png} set!: cannot set undefined variable: x") + (test-expression "(define qqq 2) (set! qqq 1)" "") + (test-expression "(cond ((= 1 2) 3))" "") + (test-expression "(cons 1 2)" "(1 . 2)") + (test-expression "(+ (list 1) 2)" "{stop-multi.png} {stop-22x22.png} +: expects type as 1st argument, given: (1); other arguments were: 2") + (test-expression "'(1)" "(1)") + (test-expression "(define shrd (cons 1 1)) (list shrd shrd)" + "((1 . 1) (1 . 1))") + (test-expression + "(local ((define x x)) 1)" + #rx"define: not allowed in an expression context") + (test-expression "(letrec ((x x)) 1)" "1") + (test-expression "(if 1 1 1)" "1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1.0") + (test-expression "#i1.0" "1.0") + (test-expression "4/3" "{number 4/3 \"1 1/3\" mixed}") + (test-expression "1/3" "{number 1/3 \"1/3\" mixed}") + (test-expression "-4/3" "{number -4/3 \"-1 1/3\" mixed}") + (test-expression "-1/3" "{number -1/3 \"-1/3\" mixed}") + (test-expression "3/2" "{number 3/2 \"1 1/2\" mixed}") + (test-expression "1/2" "{number 1/2 \"1/2\" mixed}") + (test-expression "-1/2" "{number -1/2 \"-1/2\" mixed}") + (test-expression "-3/2" "{number -3/2 \"-1 1/2\" mixed}") + (test-expression "+1/3i" "0+1/3i") + (test-expression "+1/2i" "0+1/2i") + (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") + (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" #rx"reference to undefined identifier: print") + + (test-expression "(let ((f (lambda (x) x))) f)" "#") + (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") + + (test-expression "(list 1)" "(1)") + (test-expression "(car (list))" + "{stop-multi.png} {stop-22x22.png} mcar: expects argument of type ; given ()") + + (test-expression "argv" "{stop-multi.png} {stop-22x22.png} reference to undefined identifier: argv") + (test-expression "(define-syntax app syntax-case)" + "{stop-22x22.png} macro-transformer: only a `syntax-rules' form is allowed in: syntax-case") + + (test-expression "#lang racket" + (regexp (regexp-quote "#%module-begin: illegal use (not a module body) in: (#%module-begin)")) + #rx"read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + #rx"reference to undefined identifier"))) + + +; +; ;;; ;; +; ;; ;; +; ;; +; ;;;;; ;;;; ;;;;;;;;; ;;; ;; ;;; ;; ;;;; ;;; ;; +; ;; ;; ;; ;; ;; ;; ;; ;;; ;; ;;; ;; ;; ;; ;;;;; +; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; +; ;; ;; ;;;;;; ;;;; ;; ;; ;; ;; ;; ;;;;;; ;; +; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; +; ;; ;; ;; ; ;;;;; ;; ;; ;; ;; ;; ;; ; ;; +; ;;;;; ;;;; ;;;;;;;;;; ;;;; ;;; ;;;; ;;; ;;;; ;;;; +; ;; ;; +; ;; ;; +; ;;;;; + +(define (beginner) + (parameterize ([language (list "How to Design Programs" #rx"Beginning Student(;|$)")]) + (check-top-of-repl) + (generic-settings #t) + (generic-output #f #f #f #f) + (teaching-language-fraction-output) + + (test-hash-bang) + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" + "'|.|" + "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "true" + "true") + + (test-expression "(define x 1)(define x 2)" + "x: this name was defined previously and cannot be re-defined" + "x: this name was defined previously and cannot be re-defined") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "(make-spider 4)" + "spider: this name was defined previously and cannot be re-defined\n(make-spider 4)") + + (test-expression "(sqrt -1)" + "0+1i" + "0+1i\n") + + (test-undefined-var "class") + (test-undefined-var "shared") + (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") + (test-expression "'(1 . 2)" "read: illegal use of \".\"") + + (test-undefined-var "call/cc") + + (test-expression "(error 'a \"~a\" 1)" "a: ~a1") + (test-expression "(error \"a\" \"a\")" "aa") + + (test-undefined-fn "(time 1)" "time")) + + (test-expression "true" + "true" + "true") + (test-undefined-var "mred^") + (test-expression "(eq? 'a 'A)" + "false" + "false") + (test-undefined-fn "(set! x 1)" "set!") + (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") + + (test-expression "(cond [(= 1 2) 3])" + "cond: all question results were false") + (test-expression "(cons 1 2)" + "cons: second argument must be a list, but received 1 and 2") + (test-expression "(+ (list 1) 2)" + "+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2") + (test-expression "'(1)" + "quote: expected the name of the symbol after the quote, but found a part") + (test-expression "(define shrd (list 1)) (list shrd shrd)" + "(cons (cons 1 empty) (cons (cons 1 empty) empty))" + "shrd: this name was defined previously and cannot be re-defined\n(cons (cons 1 empty) (cons (cons 1 empty) empty))") + (test-expression "(local ((define x x)) 1)" + "local: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression "(letrec ([x x]) 1)" + "letrec: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") + (test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1") + + (test-expression "1.0" "1" "1") + (test-expression "#i1.0" "#i1.0" "#i1.0") + (test-expression "4/3" + "{number 4/3 \"1.3\" decimal}" + "{number 4/3 \"1.3\" decimal}") + (test-expression "1/3" + "{number 1/3 \"0.3\" decimal}" + "{number 1/3 \"0.3\" decimal}") + (test-expression "-4/3" + "{number -4/3 \"-1.3\" decimal}" + "{number -4/3 \"-1.3\" decimal}") + (test-expression "-1/3" + "{number -1/3 \"-0.3\" decimal}" + "{number -1/3 \"-0.3\" decimal}") + (test-expression "3/2" + "{number 3/2 \"1.5\" decimal}" + "{number 3/2 \"1.5\" decimal}") + (test-expression "1/2" + "{number 1/2 \"0.5\" decimal}" + "{number 1/2 \"0.5\" decimal}") + (test-expression "-1/2" + "{number -1/2 \"-0.5\" decimal}" + "{number -1/2 \"-0.5\" decimal}") + (test-expression "-3/2" + "{number -3/2 \"-1.5\" decimal}" + "{number -3/2 \"-1.5\" decimal}") + (test-expression "+1/3i" + "0+1/3i" + "0+1/3i") + (test-expression "+1/2i" + "0+0.5i" + "0+0.5i") + (test-expression "779625/32258" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") + (test-expression "(exact? 1.5)" "true") + (test-undefined-fn "(print (floor (sqrt 2)))" "print") + + (test-expression "(let ([f (lambda (x) x)]) f)" + "let: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression ",1" + "read: illegal use of comma") + + (test-expression "(list 1)" + "(cons 1 empty)" + "(cons 1 empty)") + (test-expression "(car (list))" + "car: expects a pair; given empty") + + (test-undefined-var "argv") + (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") + + (test-expression "#lang racket" + "module: this function is not defined" + "read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "define: expected at least one variable after the function name, but found none" + #rx"define: function definitions are not allowed in the interactions window")) + + +; +; ;;; ;;; ;;; +; ;; ; ;; ;; +; ;; ; ;; ;; +; ;;;;; ;;;; ;;;;;; ; ;;;; ;;;;; ;;;;; ;;; ;; ;;;; ;;; ;;; +; ;; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;;;;; ;; ;; ;; ; +; ;; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; ;; ;; ; +; ;; ;; ;;;;;; ;;;; ; ;;;;; ;; ;; ;; ;; ;; ;;;;;; ;;; +; ;; ;; ;; ; ; ;; ;; ;; ;; ;; ;; ;; ;; ;;; +; ;; ;; ;; ; ;;;;; ; ;; ;; ;; ;; ;; ;; ;; ;; ; ;;; +; ;;;;; ;;;; ;;;;;; ; ;;;;;; ;;;;; ;;;;; ;;;; ;;;; ; +; ;; ;;; +; ;; ;;; +; ;;;;; + + +(define (beginner/abbrev) + (parameterize ([language (list "How to Design Programs" + #rx"Beginning Student with List Abbreviations(;|$)")]) + (check-top-of-repl) + + (generic-settings #t) + (generic-output #t #f #f #f) + (teaching-language-fraction-output) + + (test-hash-bang) + + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" + "'|.|" + "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "true" + "true") + + (test-expression "(define x 1)(define x 2)" + "x: this name was defined previously and cannot be re-defined" + "x: this name was defined previously and cannot be re-defined") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "(make-spider 4)" + "spider: this name was defined previously and cannot be re-defined\n(make-spider 4)") + + (test-expression "(sqrt -1)" + "0+1i" + "0+1i") + + (test-undefined-var "class") + (test-undefined-var "shared") + + (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") + (test-expression "'(1 . 2)" "read: illegal use of \".\"") + + (test-undefined-var "call/cc") + + (test-expression "(error 'a \"~a\" 1)" "a: ~a1") + (test-expression "(error \"a\" \"a\")" "aa") + + (test-undefined-fn "(time 1)" "time") + + (test-expression "true" + "true" + "true") + (test-undefined-var "mred^") + (test-expression "(eq? 'a 'A)" + "false" + "false") + (test-undefined-fn "(set! x 1)" "set!") + (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") + (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") + (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "'(1)" + "(list 1)" + "(list 1)") + (test-expression "(define shrd (list 1)) (list shrd shrd)" + "(list (list 1) (list 1))" + "shrd: this name was defined previously and cannot be re-defined\n(list (list 1) (list 1))") + (test-expression "(local ((define x x)) 1)" + "local: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression "(letrec ([x x]) 1)" + "letrec: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") + (test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1") + + (test-expression "1.0" "1" "1") + (test-expression "#i1.0" "#i1.0" "#i1.0") + (test-expression "4/3" + "{number 4/3 \"1.3\" decimal}" + "{number 4/3 \"1.3\" decimal}") + (test-expression "1/3" + "{number 1/3 \"0.3\" decimal}" + "{number 1/3 \"0.3\" decimal}") + (test-expression "-4/3" + "{number -4/3 \"-1.3\" decimal}" + "{number -4/3 \"-1.3\" decimal}") + (test-expression "-1/3" + "{number -1/3 \"-0.3\" decimal}" + "{number -1/3 \"-0.3\" decimal}") + (test-expression "3/2" + "{number 3/2 \"1.5\" decimal}" + "{number 3/2 \"1.5\" decimal}") + (test-expression "1/2" + "{number 1/2 \"0.5\" decimal}" + "{number 1/2 \"0.5\" decimal}") + (test-expression "-1/2" + "{number -1/2 \"-0.5\" decimal}" + "{number -1/2 \"-0.5\" decimal}") + (test-expression "-3/2" + "{number -3/2 \"-1.5\" decimal}" + "{number -3/2 \"-1.5\" decimal}") + (test-expression "+1/3i" + "0+1/3i" + "0+1/3i") + (test-expression "+1/2i" + "0+0.5i" + "0+0.5i") + (test-expression "779625/32258" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") + (test-expression "(exact? 1.5)" "true") + (test-undefined-fn "(print (floor (sqrt 2)))" "print") + + (test-expression "(let ([f (lambda (x) x)]) f)" + "let: this function is not defined" + "function call: expected a function after the open parenthesis, but found a part") + (test-expression ",1" + "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") + + (test-expression "(list 1)" + "(list 1)" + "(list 1)") + (test-expression "(car (list))" "car: expects a pair; given empty") + + (test-undefined-var "argv") + + (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") + + (test-expression "#lang racket" + "module: this function is not defined" + "read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "define: expected at least one variable after the function name, but found none" + #rx"define: function definitions are not allowed in the interactions window"))) + + +; +; ;; ;;; ;; +; ;; ;; ;; ;; ;; +; ;; ;; ;; +; ;;; ;;; ;; ;;;;; ;;;; ;;; ;; ;;; ;; ;; ;;;; ;;;;; ;;; ;;;; ;;;;; ;;;; +; ;; ;;; ;; ;; ;; ;; ;;;;; ;;; ;;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; +; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; +; ;; ;; ;; ;; ;;;;;; ;; ;; ;; ;; ;;;;;; ;; ;; ;; ;;;;; ;; ;;;;;; +; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; ;; +; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ; ;; ;; ;; ;; ;; ;; ;; ; +; ;;;; ;;;; ;;; ;;; ;;;; ;;;; ;;;; ;;; ;;; ;;;; ;;;;;; ;;;; ;;;;;; ;;; ;;;; +; +; +; + + +(define (intermediate) + (parameterize ([language (list "How to Design Programs" #rx"Intermediate Student(;|$)")]) + (check-top-of-repl) + + (generic-settings #t) + (generic-output #t #f #f #f) + (teaching-language-fraction-output) + + (test-hash-bang) + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" + "'|.|" + "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "true" + "true") + + (test-expression "(define x 1)(define x 2)" + "x: this name was defined previously and cannot be re-defined" + "x: this name was defined previously and cannot be re-defined") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "(make-spider 4)" + "spider: this name was defined previously and cannot be re-defined\n(make-spider 4)") + + (test-expression "(sqrt -1)" + "0+1i" + "0+1i") + + (test-undefined-var "class") + (test-undefined-var "shared") + + (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") + (test-expression "'(1 . 2)" "read: illegal use of \".\"") + + (test-undefined-var "call/cc") + + (test-expression "(error 'a \"~a\" 1)" "a: ~a1") + (test-expression "(error \"a\" \"a\")" "aa") + + (test-expression "(time 1)" + #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") + + (test-expression "true" + "true" + "true") + (test-undefined-var "mred^") + (test-expression "(eq? 'a 'A)" + "false" + "false") + (test-undefined-fn "(set! x 1)" "set!") + (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") + (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") + (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2") + (test-expression "'(1)" + "(list 1)" + "(list 1)") + (test-expression "(define shrd (list 1)) (list shrd shrd)" + "(list (list 1) (list 1))" + "shrd: this name was defined previously and cannot be re-defined\n(list (list 1) (list 1))") + (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") + (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") + (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1" "1") + (test-expression "#i1.0" "#i1.0" "#i1.0") + (test-expression "4/3" + "{number 4/3 \"1.3\" decimal}" + "{number 4/3 \"1.3\" decimal}") + (test-expression "1/3" + "{number 1/3 \"0.3\" decimal}" + "{number 1/3 \"0.3\" decimal}") + (test-expression "-4/3" + "{number -4/3 \"-1.3\" decimal}" + "{number -4/3 \"-1.3\" decimal}") + (test-expression "-1/3" + "{number -1/3 \"-0.3\" decimal}" + "{number -1/3 \"-0.3\" decimal}") + (test-expression "3/2" + "{number 3/2 \"1.5\" decimal}" + "{number 3/2 \"1.5\" decimal}") + (test-expression "1/2" + "{number 1/2 \"0.5\" decimal}" + "{number 1/2 \"0.5\" decimal}") + (test-expression "-1/2" + "{number -1/2 \"-0.5\" decimal}" + "{number -1/2 \"-0.5\" decimal}") + (test-expression "-3/2" + "{number -3/2 \"-1.5\" decimal}" + "{number -3/2 \"-1.5\" decimal}") + (test-expression "+1/3i" + "0+1/3i" + "0+1/3i") + (test-expression "+1/2i" + "0+0.5i" + "0+0.5i") + (test-expression "779625/32258" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") + (test-expression "(exact? 1.5)" "true") + (test-undefined-fn "(print (floor (sqrt 2)))" "print") + + (test-expression "(let ([f (lambda (x) x)]) f)" + "function:f" + "function:f") + (test-expression ",1" + "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") + + (test-expression "(list 1)" + "(list 1)" + "(list 1)") + (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-undefined-var "argv") + + (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") + + (test-expression "#lang racket" + "module: this function is not defined" + "read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "define: expected at least one variable after the function name, but found none" + #rx"define: expected at least one variable after the function name, but found none"))) + + + +; +; +; +; ;; ; ;;;;;; ;;;; ;;;; +; ;; ;; ;;;;;; ;;;; ;;;; +; ;;;; ;;; ;;;;; ;;;;;; ;;;;;;; ;;;;;;; ;;;; ;;;;;;; ;;;;;;; ;;;;;;; +; ;;;; ;;;;;;;;; ;;;;;; ;;;;;; ;;;;;;;; ;;;;;;;;;;;;; ;;;;;;;; ;;;;;;;; ;;;;;;;; +; ;;;; ;;;; ;;;; ;;;; ;;;;;; ;;;; ;;;; ;;; ;;;; ;;;;;;;;; ;;;;;;;;; ;;;; +; ;;;; ;;;; ;;;; ;;;; ;; ;;;; ;;;;;;; ;;;; ;;; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;;;;; +; ;;;; ;;;; ;;;; ;;;;; ;; ;;;; ;; ;;;; ;;;; ;;; ;;;; ;;;;;;;;; ;;;;;;;;; ;; ;;;; +; ;;;; ;;;; ;;;; ;;;;; ;; ;;;; ;;;;;;;; ;;;; ;;; ;;;; ;;;;;;;; ;;;;;;;; ;;;;;;;; +; ;;;; ;;;; ;;;; ;;;; ;; ;;;; ;; ;;;; ;;;; ;;; ;;;; ;;;;;;; ;;;;;;; ;; ;;;; +; ;; +; +; + + +(define (intermediate/lambda) + (parameterize ([language (list "How to Design Programs" + #rx"Intermediate Student with lambda(;|$)")]) + (check-top-of-repl) + + (generic-settings #t) + (generic-output #t #f #f #f) + (teaching-language-fraction-output) + + (test-hash-bang) + (test-error-after-definition) + + (prepare-for-test-expression) + + (test-expression "'|.|" + "'|.|" + "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "true" + "true") + (test-expression "(define x 1)(define x 2)" + "x: this name was defined previously and cannot be re-defined" + "x: this name was defined previously and cannot be re-defined") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "(make-spider 4)" + "spider: this name was defined previously and cannot be re-defined\n(make-spider 4)") + + (test-expression "(sqrt -1)" + "0+1i" + "0+1i") + + (test-undefined-var "class") + (test-undefined-var "shared") + + (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") + (test-expression "'(1 . 2)" "read: illegal use of \".\"") + + (test-undefined-var "call/cc") + + (test-expression "(error 'a \"~a\" 1)" "a: ~a1") + (test-expression "(error \"a\" \"a\")" "aa") + + (test-expression "(time 1)" + #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") + + (test-expression "true" + "true" + "true") + (test-undefined-var "mred^") + (test-expression "(eq? 'a 'A)" + "false" + "false") + (test-undefined-fn "(set! x 1)" "set!") + (test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!") + (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") + (test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2") + (test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "'(1)" + "(list 1)" + "(list 1)") + (test-expression "(define shrd (list 1)) (list shrd shrd)" + "(list (list 1) (list 1))" + "shrd: this name was defined previously and cannot be re-defined\n(list (list 1) (list 1))") + (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") + (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") + (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1" "1") + (test-expression "#i1.0" "#i1.0" "#i1.0") + (test-expression "4/3" + "{number 4/3 \"1.3\" decimal}" + "{number 4/3 \"1.3\" decimal}") + (test-expression "1/3" + "{number 1/3 \"0.3\" decimal}" + "{number 1/3 \"0.3\" decimal}") + (test-expression "-4/3" + "{number -4/3 \"-1.3\" decimal}" + "{number -4/3 \"-1.3\" decimal}") + (test-expression "-1/3" + "{number -1/3 \"-0.3\" decimal}" + "{number -1/3 \"-0.3\" decimal}") + (test-expression "3/2" + "{number 3/2 \"1.5\" decimal}" + "{number 3/2 \"1.5\" decimal}") + (test-expression "1/2" + "{number 1/2 \"0.5\" decimal}" + "{number 1/2 \"0.5\" decimal}") + (test-expression "-1/2" + "{number -1/2 \"-0.5\" decimal}" + "{number -1/2 \"-0.5\" decimal}") + (test-expression "-3/2" + "{number -3/2 \"-1.5\" decimal}" + "{number -3/2 \"-1.5\" decimal}") + (test-expression "+1/3i" "0+1/3i" "0+1/3i") + (test-expression "+1/2i" "0+0.5i" "0+0.5i") + (test-expression "779625/32258" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") + (test-expression "(exact? 1.5)" "true") + (test-undefined-fn "(print (floor (sqrt 2)))" "print") + + (test-expression "(let ([f (lambda (x) x)]) f)" + "(lambda (a1) ...)" + "(lambda (a1) ...)") + (test-expression ",1" + "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") + + (test-expression "(list 1)" + "(list 1)" + "(list 1)") + (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-undefined-var "argv") + + (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") + + (test-expression "#lang racket" + "module: this function is not defined" + "read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + "define: expected at least one variable after the function name, but found none" + #rx"define: expected at least one variable after the function name, but found none"))) + + + +; +; +; +; ;;;; ;;;; +; ;;;; ;;;; +; ;;;;;;; ;;;;;;; ;;; ;;; ;;;;;;; ;;;; ;;; ;;;;; ;;; ;;;;;;; +; ;;;;;;;; ;;;;;;;; ;;; ;;; ;;;;;;;; ;;;;;;;;; ;;;;;; ;;;;; ;;;;;;;; +; ;;;; ;;;;;;;;; ;;;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;; ;;;;;;;;; +; ;;;;;;; ;;;; ;;;; ;;;;;; ;;;;;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;; ;;;; +; ;; ;;;; ;;;;;;;;; ;;;;;; ;; ;;;; ;;;; ;;;; ;;;;;;; ;;;;; ;;;;;;;;; +; ;;;;;;;; ;;;;;;;; ;;;; ;;;;;;;; ;;;; ;;;; ;;;;;; ;;;;;; ;;;;;;;; +; ;; ;;;; ;;;;;;; ;;;; ;; ;;;; ;;;; ;;;; ;;;;; ;;;; ;;;;;;; +; +; +; + + +(define (advanced) + (parameterize ([language (list "How to Design Programs" #rx"Advanced Student(;|$)")]) +; (check-top-of-repl) + +; (generic-settings #t) +; (generic-output #t #t #t #f) +; (teaching-language-fraction-output) + +; (test-hash-bang) +; (test-error-after-definition) + + (prepare-for-test-expression) + #| + (test-expression "'|.|" + "'|.|" + "'|.|") + (test-expression '("(equal? (list " image ") (list " image "))") + "true" + "true") + (test-expression "(define x 1)(define x 2)" + "x: this name was defined previously and cannot be re-defined" + "x: this name was defined previously and cannot be re-defined") + + (test-expression "(define-struct spider (legs))(make-spider 4)" + "(make-spider 4)" + "spider: this name was defined previously and cannot be re-defined\n(make-spider 4)") + + (test-expression "(sqrt -1)" + "0+1i" + "0+1i") + |# + (test-undefined-var "class") + + (test-expression "shared" "shared: found a use that does not follow an open parenthesis") + + (test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"") + (test-expression "'(1 . 2)" "read: illegal use of \".\"") + + (test-undefined-var "call/cc") + + (test-expression "(error 'a \"~a\" 1)" "a: ~a1") + (test-expression "(error \"a\" \"a\")" "aa") + + (test-expression "(time 1)" + #rx"cpu time: [0-9]+ real time: [0-9]+ gc time: [0-9]+\n1") + + (test-expression "true" + "true" + "true") + (test-undefined-var "mred^") + (test-expression "(eq? 'a 'A)" + "false" + "false") + (test-expression "(set! x 1)" + "x: this variable is not defined" + "set!: cannot set variable before its definition: x") + (test-expression "(define qqq 2) (set! qqq 1)" + "(void)" + "qqq: this name was defined previously and cannot be re-defined\n(void)") + (test-expression "(cond [(= 1 2) 3])" "cond: all question results were false") + (test-expression "(cons 1 2)" "cons: second argument must be a list or cyclic list, but received 1 and 2") + (test-expression "(+ (list 1) 2)" "+: expects type as 1st argument, given: (list 1); other arguments were: 2") + (test-expression "'(1)" + "(list 1)" + "(list 1)") + (test-expression "(define shrd (list 1)) (list shrd shrd)" + "(shared ((-1- (list 1))) (list -1- -1-))" + "shrd: this name was defined previously and cannot be re-defined\n(shared ((-1- (list 1))) (list -1- -1-))") + (test-expression "(local ((define x x)) 1)" "local variable used before its definition: x") + (test-expression "(letrec ([x x]) 1)" "local variable used before its definition: x") + (test-expression "(if 1 1 1)" "if: question result is not true or false: 1") + (test-expression "(+ 1)" "1") + + (test-expression "1.0" "1" "1") + (test-expression "#i1.0" "#i1.0" "#i1.0") + (test-expression "4/3" + "{number 4/3 \"1.3\" decimal}" + "{number 4/3 \"1.3\" decimal}") + (test-expression "1/3" + "{number 1/3 \"0.3\" decimal}" + "{number 1/3 \"0.3\" decimal}") + (test-expression "-4/3" + "{number -4/3 \"-1.3\" decimal}" + "{number -4/3 \"-1.3\" decimal}") + (test-expression "-1/3" + "{number -1/3 \"-0.3\" decimal}" + "{number -1/3 \"-0.3\" decimal}") + (test-expression "3/2" + "{number 3/2 \"1.5\" decimal}" + "{number 3/2 \"1.5\" decimal}") + (test-expression "1/2" + "{number 1/2 \"0.5\" decimal}" + "{number 1/2 \"0.5\" decimal}") + (test-expression "-1/2" + "{number -1/2 \"-0.5\" decimal}" + "{number -1/2 \"-0.5\" decimal}") + (test-expression "-3/2" + "{number -3/2 \"-1.5\" decimal}" + "{number -3/2 \"-1.5\" decimal}") + (test-expression "+1/3i" + "0+1/3i" + "0+1/3i") + (test-expression "+1/2i" + "0+0.5i" + "0+0.5i") + (test-expression "779625/32258" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" + "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" "#i1.0") + + (test-expression "(let ([f (lambda (x) x)]) f)" + "(lambda (a1) ...)" + "(lambda (a1) ...)") + (test-expression ",1" + "unquote: misuse of a comma or unquote, not under a quasiquoting backquote") + + (test-expression "(list 1)" + "(list 1)" + "(list 1)") + (test-expression "(car (list))" "car: expects argument of type ; given empty") + (test-undefined-var "argv") + + (test-undefined-fn "(define-syntax app syntax-case)" "define-syntax") + + (test-expression "#lang racket" + "module: this function is not defined" + "read: #lang not enabled in the current context") + (test-expression "(define (f)\n(+ (raise-user-error 'a \"b\")))\n(if (zero? (random 1)) (void) (set! f void))\n(f)" + #rx"raise-user-error" + #rx"raise-user-error"))) + + + + +(define (prepare-for-test-expression) + (let ([drs (wait-for-drscheme-frame)]) + (clear-definitions drs) + (set-language #t) + (sleep 1) ;; this shouldn't be neccessary.... + (do-execute drs))) + +;; test-setting : (-> void) string string string -> void +;; opens the language dialog, runs `set-setting' +;; closes the language dialog, executes, +;; makes sure that `expression' produces +;; `result'. `set-setting' is expected to click around +;; in the language dialog. +;; `setting-name' is used in the error message when the test fails. +(define (test-setting set-setting setting-name expression result) + (set-language #f) + (set-setting) + (let ([f (get-top-level-focus-window)]) + (fw:test:button-push "OK") + (wait-for-new-frame f)) + (let* ([drs (get-top-level-focus-window)] + [interactions (send drs get-interactions-text)]) + (clear-definitions drs) + (type-in-definitions drs expression) + (do-execute drs) + (let* ([got (fetch-output/should-be-tested drs)]) + (unless (string=? result got) + (fprintf (current-error-port) + "FAILED: ~s ~s ~s test\n expected: ~s\n got: ~s\n" + (language) setting-name expression result got))))) + +(define (test-hash-bang) + (let* ([expression "#!/bin/sh\n1"] + [result "1"] + [drs (get-top-level-focus-window)] + [interactions (queue-callback (λ () (send drs get-interactions-text)))]) + (clear-definitions drs) + (type-in-definitions drs expression) + (do-execute drs) + (let* ([got (fetch-output/should-be-tested drs)]) + (unless (string=? "1" got) + (fprintf (current-error-port) + "FAILED: ~s ~a test\n expected: ~s\n got: ~s\n" + (language) expression result got))))) + +(define (fetch-output/should-be-tested . args) + (regexp-replace (regexp + (string-append + (regexp-quote "") + "$")) + (apply fetch-output args) + "")) + +(define (check-top-of-repl) + (let ([drs (wait-for-drscheme-frame)]) + (set-language #t) + (with-handlers ([exn:fail? void]) + (fw:test:menu-select "Testing" "Disable tests")) + (do-execute drs) + (let* ([interactions (send drs get-interactions-text)] + [short-lang (last (language))] + [get-line (lambda (n) + (queue-callback/res + (λ () + (send interactions get-text + (send interactions paragraph-start-position n) + (send interactions paragraph-end-position n)))))] + [line0-expect (format "Welcome to DrRacket, version ~a [~a]." + (version:version) + (system-type 'gc))] + [line1-expect + (if (string? short-lang) + (format "Language: ~a" short-lang) + short-lang)] + [line0-got (get-line 0)] + [line1-got (get-line 1)]) + (unless (and (string=? line0-expect line0-got) + (if (string? short-lang) + (string=? line1-expect (substring line1-got + 0 + (min (string-length line1-expect) + (string-length line1-got)))) + (regexp-match line1-expect line1-got))) + (fprintf (current-error-port) + "expected lines: \n ~a\n ~a\ngot lines:\n ~a\n ~a\n" + line0-expect line1-expect + line0-got line1-got) + (error 'language-test.rkt "failed get top of repl test"))))) + + +;; teaching-language-fraction-output +;; tests that the teaching languages properly handle repeating decimals +(define (teaching-language-fraction-output) + (test-setting + (lambda () (fw:test:set-radio-box! "Fraction Style" "Mixed fractions")) + "Fraction Style -- Mixed fractions" + "4/3" + "{number 4/3 \"1 1/3\" mixed}") + (test-setting + (lambda () (fw:test:set-radio-box! "Fraction Style" "Repeating decimals")) + "Fraction Style -- Repeating decimals" + "4/3" + "{number 4/3 \"1.3\" decimal}")) + +;; plt-language-fraction-output : -> void +;; tests that the PLT languages properly handle repeating decimals +(define (plt-language-fraction-output) + (test-setting + (lambda () (fw:test:set-check-box! "Use decimal notation for rationals" #f)) + "Use decimal notation for rationals -- #f" + "4/3 1/2 -1/3" + "{number 4/3 \"1 1/3\" mixed}\n{number 1/2 \"1/2\" mixed}\n{number -1/3 \"- 1/3\" mixed}") + (test-setting + (lambda () (fw:test:set-check-box! "Use decimal notation for rationals" #t)) + "Use decimal notation for rationals -- #t" + "4/3 1/2 -1/3" + "{number 4/3 \"#e1.3\" decimal}\n{number 1/2 \"#e0.5\" decimal}\n{number -1/3 \"#e-0.3\" decimal}")) + +(define (generic-settings false/true?) + (test-setting + (lambda () (fw:test:set-check-box! "Case sensitive" #t)) + "Case sensitive -- #t" + "(eq? 'g 'G)" + (if false/true? "false" "#f")) + (test-setting + (lambda () (fw:test:set-check-box! "Case sensitive" #f)) + "Case sensitive -- #f" + "(eq? 'g 'G)" + (if false/true? "true" "#t"))) + +(define (generic-output list? quasi-quote? has-sharing? has-print-printing?) + (let* ([plain-print-style (if has-print-printing? "print" "write")] + [drs (wait-for-drscheme-frame)] + [expression "(define x (list 2))\n(list x x)"] + [set-output-choice + (lambda (option show-sharing pretty?) + (set-language #f) + (fw:test:set-radio-box! "Output Style" option) + (when (and has-sharing? show-sharing) + (fw:test:set-check-box! + "Show sharing in values" + (if (eq? show-sharing 'on) #t #f))) + (fw:test:set-check-box! + "Insert newlines in printed values" + pretty?) + (let ([f (get-top-level-focus-window)]) + (fw:test:button-push "OK") + (wait-for-new-frame f)))] + [shorten + (lambda (str) + (if ((string-length str) . <= . 45) + str + (string-append (substring str 0 45) "...")))] + [test + ;; answer must either be a string, or a procedure that accepts both zero and 1 + ;; argument. When the procedure accepts 1 arg, the argument is `got' and + ;; the result must be a boolean indicating if the result was satisfactory. + ;; if the procedure receives no arguments, it must return a descriptive string + ;; for the error message + (lambda (option show-sharing pretty? answer) + (set-output-choice option show-sharing pretty?) + (do-execute drs) + (let ([got (fetch-output/should-be-tested drs)]) + (unless (if (procedure? answer) + (answer got) + (whitespace-string=? answer got)) + (fprintf (current-error-port) + "FAILED ~s ~a, sharing ~a pretty? ~a\n got ~s\n expected ~s\n" + (language) option show-sharing pretty? + (shorten got) + (if (procedure? answer) (answer) answer)))))]) + + (clear-definitions drs) + (type-in-definitions drs expression) + + (test plain-print-style 'off #t "((2) (2))") + (when has-sharing? + (test plain-print-style 'on #t "(#0=(2) #0#)")) + (when quasi-quote? + (test "Quasiquote" 'off #t "`((2) (2))") + (when has-sharing? + (test "Quasiquote" 'on #t "(shared ((-1- `(2))) `(,-1- ,-1-))"))) + + (test "Constructor" 'off #t + (if list? + "(list (list 2) (list 2))" + "(cons (cons 2 empty) (cons (cons 2 empty) empty))")) + (when has-sharing? + (test "Constructor" 'on #t + (if list? + "(shared ((-1- (list 2))) (list -1- -1-))" + "(shared ((-1- (cons 2 empty))) (cons -1- (cons -1- empty)))"))) + + ;; setup print / pretty-print difference + (clear-definitions drs) + (for-each fw:test:keystroke + (string->list + "(define (f n)\n(cond ((zero? n) (list))\n(else (cons n (f (- n 1))))))\n(f 200)")) + (test "Constructor" #f #f + (case-lambda + [(x) (not (member #\newline (string->list x)))] + [() "no newlines in result"])) + (test "Constructor" #f #t + (case-lambda + [(x) (member #\newline (string->list x))] + [() "newlines in result (may need to make the window smaller)"])) + (test plain-print-style #f #f + (case-lambda + [(x) (not (member #\newline (string->list x)))] + [() "no newlines in result"])) + (test plain-print-style #f #t + (case-lambda + [(x) (member #\newline (string->list x))] + [() "newlines in result (may need to make the window smaller)"])))) + +(define re:out-of-sync + (regexp + "WARNING: Interactions window is out of sync with the definitions window\\.")) + +(define (test-error-after-definition) + (let* ([drs (wait-for-drscheme-frame)] + [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))]) + (clear-definitions drs) + (type-in-definitions drs "(define y 0) (define (f x) (/ x y)) (f 2)") + (do-execute drs) + (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) + (type-in-interactions drs "y\n") + (wait-for-computation drs) + (let ([got + (fetch-output/should-be-tested + drs + (queue-callback/res (λ () (send interactions-text paragraph-start-position (+ last-para 1)))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) + (unless (equal? got "0") + (fprintf (current-error-port) + "FAILED: test-error-after-definition failed, expected 0, got ~s\n" got)))))) + + +;; test-expression : (union string 'xml 'image (listof (union string 'xml 'image))) +;; (union string regexp (string -> boolean)) +;; -> void +;; types an expression in the definitions window, executes it and tests the output +;; types an expression in the REPL and tests the output from the REPL. +(define (test-expression expression defs-expected [repl-expected defs-expected]) + (printf "test-expression ~a~n" expression) + (let* ([drs (wait-for-drscheme-frame)] + [interactions-text (queue-callback/res (λ () (send drs get-interactions-text)))] + [definitions-text (queue-callback/res (λ () (send drs get-definitions-text)))] + [handle-insertion + (lambda (item) + (cond + [(eq? item 'image) + (use-get/put-dialog + (lambda () (fw:test:menu-select "Insert" "Insert Image...")) + (simplify-path (build-path (collection-path "icons") "recycle.png")))] + [(string? item) + (insert-in-definitions drs item)] + [(eq? item 'xml) + (fw:test:menu-select "Insert" "Insert XML Box") + (for-each fw:test:keystroke (string->list ""))] + [else (error 'handle-insertion "unknown thing to insert ~s" item)]))] + [check-expectation + (lambda (expected got) + (cond + [(string? expected) + (whitespace-string=? expected got)] + [(regexp? expected) + (regexp-match expected got)] + [(procedure? expected) + (expected got)]))] + [make-err-msg + (lambda (expected) + (cond + [(string? expected) + "FAILED: ~s ~s expected ~s to produce:\n ~s\ngot:\n ~s\ninstead\n"] + [(regexp? expected) + "FAILED: ~s ~s expected ~s to match ~s, got ~s instead\n"] + [(procedure? expected) + "FAILED: ~s ~s expected ~s to pass predicate ~s, got ~s\n"]))]) + (clear-definitions drs) + (insert-in-definitions drs (defs-prefix)) + (cond + [(pair? expression) (for-each handle-insertion expression)] + [else (handle-insertion expression)]) + (do-execute drs) + + (let ([got + (fetch-output + drs + (queue-callback/res (λ () (send interactions-text paragraph-start-position 2))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) + (when (regexp-match re:out-of-sync got) + (error 'text-expression "got out of sync message")) + (unless (check-expectation defs-expected got) + (fprintf (current-error-port) + (make-err-msg defs-expected) + 'definitions (language) expression defs-expected got))) + + (let ([dp (defs-prefix)]) + (queue-callback/res + (λ () + ;; select all except the defs-prefix + (send definitions-text set-position + (string-length dp) + (send definitions-text last-position)) + + (send definitions-text copy) + (send interactions-text set-position + (send interactions-text last-position) + (send interactions-text last-position)) + (send interactions-text paste)))) + + (let ([last-para (queue-callback/res (λ () (send interactions-text last-paragraph)))]) + (alt-return-in-interactions drs) + (wait-for-computation drs) + (let ([got + (fetch-output + drs + (queue-callback/res + (λ () + (send interactions-text paragraph-start-position (+ last-para 1)))) + (queue-callback/res + (λ () + (send interactions-text paragraph-end-position + (- (send interactions-text last-paragraph) 1)))))]) + (when (regexp-match re:out-of-sync got) + (error 'text-expression "got out of sync message")) + (unless (check-expectation repl-expected got) + (fprintf (current-error-port) + (make-err-msg repl-expected) + 'interactions + (language) + expression repl-expected got)))))) + +(define (test-undefined-var id) + (test-expression id (format "~a: this variable is not defined" id))) + +(define (test-undefined-fn exp id) + (test-expression exp (format "~a: this function is not defined" id))) + +(define-syntax (go stx) + (syntax-case stx () + [(_ arg) + (identifier? (syntax arg)) + (syntax (begin (flush-output) + (printf ">> starting ~a\n" 'arg) + (flush-output) + (arg) + (flush-output) + (printf ">> finished ~a\n" 'arg) + (flush-output)))])) + +(define (run-test) + (go module-lang) + (go pretty-big) + (go r5rs) + (go beginner) + (go beginner/abbrev) + (go intermediate) + (go intermediate/lambda) + (go advanced) + ) + +(fire-up-drscheme-and-run-tests run-test) diff --git a/collects/tests/gracket/testing.rktl b/collects/tests/gracket/testing.rktl index 573a5e1c91..33f7bebdd7 100644 --- a/collects/tests/gracket/testing.rktl +++ b/collects/tests/gracket/testing.rktl @@ -49,6 +49,8 @@ (test vals 'method (call-with-values (lambda () (send obj method . args)) list)))]))) (define (report-errs) + (flush-output) + (sleep 1) (newline) (if (null? errs) (printf "Passed all ~a tests\n" test-count) diff --git a/collects/tests/htdp-lang/advanced.rktl b/collects/tests/htdp-lang/advanced.rktl index 46e8eb0b1e..2eab6df38a 100644 --- a/collects/tests/htdp-lang/advanced.rktl +++ b/collects/tests/htdp-lang/advanced.rktl @@ -61,15 +61,19 @@ (htdp-test 2 'begin0 (begin0 2 1)) (htdp-test 3 'begin0 (begin0 3 2 1)) + (htdp-syntax-test #'set! "set!: found a use that does not follow an open parenthesis") (htdp-syntax-test #'(set!) "set!: expected a variable after set!, but nothing's there") (htdp-syntax-test #'(set! x) "set!: expected an expression for the new value, but nothing's there") (htdp-syntax-test #'(set! 1 2) "set!: expected a variable after set!, but found a number") (htdp-syntax-test #'(set! x 2 3) "set!: expected only one expression for the new value, but found 1 extra part") (htdp-syntax-test #'(set! set! 2) "set!: expected a variable after set!, but found a set!") -(htdp-syntax-test #'(lambda (x) (set! x 2)) "set!: expected a mutable variable after set!, but found a variable that cannot be modified") +(htdp-syntax-test #'(set! x 1) "x: this variable is not defined") +(htdp-syntax-test #'(lambda (x) (set! x 2)) "set!: expected a mutable variable after set!, but found a variable that cannot be modified: x") + (htdp-syntax-test #'(let ([x 5]) (lambda (x) (set! x 2))) "set!: expected a mutable variable after set!, but found a variable that cannot be modified") +(htdp-top (define x 5)) (htdp-top (set! x 'hello)) (htdp-test 'hello 'access-x x) (htdp-test 18 'set! (local [(define x 12)] @@ -95,16 +99,7 @@ (htdp-top (set! x 13)) (htdp-test 12 force d) (htdp-test 13 'access-x x) - - - - - - - - -"let: bad syntax (not a sequence of identifier--expression bindings)" - +(htdp-top-pop 4) (htdp-syntax-test #'(let name) "let: expected at least one binding (in parentheses) after let, but nothing's there") (htdp-syntax-test #'(let name 10) "let: expected at least one binding (in parentheses) after let, but found a number") @@ -129,7 +124,7 @@ (htdp-syntax-test #'(case 5 [(5)]) "case: expected an expression for the answer in the case clause, but nothing's there") (htdp-syntax-test #'(case 5 [(5) 12 13]) "case: expected only one expression for the answer in the case clause, but found 1 extra part") (htdp-syntax-test #'(case 5 [("a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string") -(htdp-syntax-test #'(case 5 [() 10]) "case: expected at least one choice, but nothing's there") +(htdp-syntax-test #'(case 5 [() 10]) "expected a symbol (without its quote) or a number as a choice, but nothing's there") (htdp-syntax-test #'(case 5 [(5 "a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string") (htdp-syntax-test #'(case 5 [else 12][(5) 10]) "case: found an else clause that isn't the last clause in its case expression") (htdp-syntax-test #'(case 5 [(5) 10][else 12][else 13]) "case: found an else clause that isn't the last clause in its case expression") @@ -432,12 +427,11 @@ (htdp-syntax-test #'(define-datatype dt [(v1)]) #rx"define-datatype: expected a variant name, found a part") (htdp-syntax-test #'(define-datatype dt [v1 10]) #rx"define-datatype: in variant `v1': expected a field name, found a number") (htdp-syntax-test #'(define-datatype dt [v1] [v1]) #rx"define-datatype: found a variant name that is used more than once: v1") -(htdp-syntax-test #'(define-datatype posn [v1]) #rx"posn\\?: this name has a built-in meaning and cannot be re-defined") -(htdp-syntax-test #'(define-datatype dt [posn]) #rx"posn: this name has a built-in meaning and cannot be re-defined") +(htdp-syntax-test #'(define-datatype posn [v1]) "posn?: this name was defined previously and cannot be re-defined") +(htdp-syntax-test #'(define-datatype dt [posn]) "posn: this name was defined previously and cannot be re-defined") (htdp-syntax-test #'(define-datatype lambda [v1]) #rx"define-datatype: expected a datatype type name after `define-datatype', but found a keyword") (htdp-syntax-test #'(define-datatype dt [lambda]) #rx"define-datatype: expected a variant name, found a keyword") -(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype', -but found a part") +(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype', but found a part") (htdp-syntax-test #'(+ 1 (define-datatype dt [v1])) #rx"define-datatype: found a definition that is not at the top level") (htdp-top (define-datatype dt)) @@ -474,15 +468,15 @@ but found a part") (htdp-syntax-test #'(match 1 x) #rx"match: expected a pattern--answer clause, but found something else") (htdp-syntax-test #'(match 1 []) #rx"match: expected a pattern--answer clause, but found an empty clause") (htdp-syntax-test #'(match 1 [x]) #rx"expected an expression for the answer in a `match' clause, but nothing's there") -(htdp-syntax-test #'(match 1 [x 10 10]) #rx"expected only one expression for the answer in a `match' clause, but found one extra part") -(htdp-syntax-test #'(match 1 [x 10 x]) #rx"expected only one expression for the answer in a `match' clause, but found one extra part") +(htdp-syntax-test #'(match 1 [x 10 10]) #rx"expected only one expression for the answer in a `match' clause, but found 1 extra part") +(htdp-syntax-test #'(match 1 [x 10 x]) #rx"expected only one expression for the answer in a `match' clause, but found 1 extra part") (htdp-syntax-test #'(match 1 [x 10] 10) #rx"match: expected a pattern--answer clause, but found a number") (htdp-syntax-test #'(match 1 [x 10] x) #rx"match: expected a pattern--answer clause, but found something else") (htdp-syntax-test #'(match 1 [x 10] []) #rx"match: expected a pattern--answer clause, but found an empty clause") (htdp-syntax-test #'(match 1 [x 10] [x]) #rx"expected an expression for the answer in a `match' clause, but nothing's there") -(htdp-syntax-test #'(match 1 [x 10] [x 10 10]) #rx"expected only one expression for the answer in a `match' clause, but found one extra part") -(htdp-syntax-test #'(match 1 [x 10] [x 10 x]) #rx"expected only one expression for the answer in a `match' clause, but found one extra part") +(htdp-syntax-test #'(match 1 [x 10] [x 10 10]) #rx"expected only one expression for the answer in a `match' clause, but found 1 extra part") +(htdp-syntax-test #'(match 1 [x 10] [x 10 x]) #rx"expected only one expression for the answer in a `match' clause, but found 1 extra part") (define-syntax-rule (htdp-match/v res pat expr val) (htdp-test res 'pat (match expr [pat val] [else #f]))) diff --git a/collects/tests/htdp-lang/beg-adv.rktl b/collects/tests/htdp-lang/beg-adv.rktl index 083705e687..39741158dd 100644 --- a/collects/tests/htdp-lang/beg-adv.rktl +++ b/collects/tests/htdp-lang/beg-adv.rktl @@ -21,12 +21,12 @@ (htdp-syntax-test #'(define 1 10) "define: expected a variable name, or a function name and its variables (in parentheses), but found a number") (htdp-syntax-test #'(define x lambda) "lambda: found a use that does not follow an open parenthesis") (htdp-syntax-test #'(define x (lambda)) "lambda: expected at least one variable (in parentheses) after lambda, but nothing's there") -(htdp-syntax-test #'(define x (lambda (x))) "lambda: expected an expression after the variables, but nothing's there") +(htdp-syntax-test #'(define x (lambda (x))) "lambda: expected an expression for the function body, but nothing's there") (htdp-syntax-test #'(define x (lambda y)) "lambda: expected at least one variable (in parentheses) after lambda, but found something else") (htdp-syntax-test #'(define x (lambda y 10) "lambda: expected at least one variable (in parentheses) after lambda, but found something else")) (htdp-syntax-test #'(define x (lambda (10) 10)) "lambda: expected a variable, but found a number") (htdp-syntax-test #'(define x (lambda (x 10) 10)) "lambda: expected a variable, but found a number") -(htdp-syntax-test #'(define x (lambda (y) 10 11)) "lambda: expected only one expression after the variables, but found 1 extra part") +(htdp-syntax-test #'(define x (lambda (y) 10 11)) "lambda: expected only one expression for the function body, but found 1 extra part") (htdp-syntax-test #'(define x (lambda (y y) 10)) "lambda: found a variable that is used more than once: y") (htdp-syntax-test #'(+ (define x 5)) "define: found a definition that is not at the top level") @@ -67,6 +67,7 @@ (htdp-test 15 'app-f (f 10)) (htdp-top-pop 1) (htdp-top-pop 1) +(htdp-top-pop 1) (htdp-top (define-struct a0 ())) (htdp-top (define-struct a1 (b))) diff --git a/collects/tests/htdp-lang/bega-adv.rktl b/collects/tests/htdp-lang/bega-adv.rktl index cadb91476c..f47fbdc749 100644 --- a/collects/tests/htdp-lang/bega-adv.rktl +++ b/collects/tests/htdp-lang/bega-adv.rktl @@ -16,7 +16,7 @@ (htdp-test '(quasiquote (unquote 22)) 'qq ``,,(* 11 2)) (htdp-test '(quasiquote ((unquote-splicing (22)))) 'qq ``(,@(,@(list (* 11 2))))) -(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not precede an open parenthesis") +(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not follow an open parenthesis") (htdp-syntax-test #'`unquote "quasiquote: misuse of unquote within a quasiquoting backquote") (htdp-syntax-test #'`unquote-splicing "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote") (htdp-syntax-test #'`(unquote-splicing 10) "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote") diff --git a/collects/tests/htdp-lang/beginner.rktl b/collects/tests/htdp-lang/beginner.rktl index e12e6c7c6d..18eb52f6ce 100644 --- a/collects/tests/htdp-lang/beginner.rktl +++ b/collects/tests/htdp-lang/beginner.rktl @@ -91,7 +91,7 @@ (load-relative "beg-intm.rktl") (load-relative "beg-bega.rktl") -(htdp-syntax-test #'quote "found a use that isn't before a parenthesis") +(htdp-syntax-test #'quote "quote: found a use that does not follow an open parenthesis") (htdp-syntax-test #''1 "quote: expected the name of the symbol after the quote, but found a number") (htdp-syntax-test #''"hello" "quote: expected the name of the symbol after the quote, but found a string") (htdp-syntax-test #''(1 2) "quote: expected the name of the symbol after the quote, but found a part")