/pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl
Unknown | 1817 lines | 1663 code | 154 blank | 0 comment | 0 complexity | 7c3cee4b16f0a20309cfd1cdfe0887e1 MD5 | raw file
Large files files are truncated, but you can click here to view the full file
1 2(load-relative "loadtest.rktl") 3 4(Section 'syntax) 5 6;; ---------------------------------------- 7 8(test 0 'with-handlers (with-handlers () 0)) 9(test 1 'with-handlers (with-handlers ([void void]) 1)) 10(test 2 'with-handlers (with-handlers ([void void]) 1 2)) 11(test 'zero 'zero 12 (with-handlers ((zero? (lambda (x) 'zero))) 13 (raise 0))) 14(test 'zero 'zero 15 (with-handlers ((zero? (lambda (x) 'zero)) 16 (positive? (lambda (x) 'positive))) 17 (raise 0))) 18(test 'positive 'positive 19 (with-handlers ((zero? (lambda (x) 'zero)) 20 (positive? (lambda (x) 'positive))) 21 (raise 1))) 22(test 5 'with-handlers 23 (with-handlers ([void (lambda (x) 5)]) 24 (with-handlers ((zero? (lambda (x) 'zero))) 25 (/ 0)))) 26 27(error-test #'(with-handlers () 28 (/ 0)) 29 exn:fail:contract:divide-by-zero?) 30(error-test #'(with-handlers ((zero? (lambda (x) 'zero))) 31 (/ 0)) 32 exn:application:type?) 33(error-test #'(with-handlers ((zero? (lambda (x) 'zero)) 34 (boolean? (lambda (x) 'boolean))) 35 (/ 0)) 36 exn:application:type?) 37 38(syntax-test #'with-handlers) 39(syntax-test #'(with-handlers)) 40(syntax-test #'(with-handlers . 1)) 41(syntax-test #'(with-handlers ((zero? (lambda (x) 'zero))))) 42(syntax-test #'(with-handlers ((zero? (lambda (x) 'zero))) . 1)) 43(syntax-test #'(with-handlers (zero?) 1)) 44(syntax-test #'(with-handlers ((zero?)) 1)) 45(syntax-test #'(with-handlers ((zero? . zero?)) 1)) 46(syntax-test #'(with-handlers ((zero? zero?) . 2) 1)) 47(syntax-test #'(with-handlers ((zero? zero?) zero?) 1)) 48(syntax-test #'(with-handlers ((zero? zero?) (zero?)) 1)) 49(syntax-test #'(with-handlers ((zero? zero?) (zero?)) 1)) 50(syntax-test #'(with-handlers ((zero? zero? zero?)) 1)) 51(syntax-test #'(with-handlers ((zero? zero? . zero?)) 1)) 52(syntax-test #'(with-handlers ((zero? zero?)) 1 . 2)) 53 54(error-test #'(with-handlers ((0 void)) (/ 0)) 55 exn:application:type?) 56(error-test #'(with-handlers ((void 0)) (/ 0)) 57 exn:application:type?) 58(error-test #'(with-handlers ((unbound-variable void)) 0) 59 exn:fail:contract:variable?) 60(error-test #'(with-handlers ((void unbound-variable)) 0) 61 exn:fail:contract:variable?) 62(error-test #'(with-handlers (((values 1 2) void)) 0) 63 arity?) 64(error-test #'(with-handlers ((void (values 1 2))) 0) 65 arity?) 66 67(test-values '(1 2) (lambda () (with-handlers ([void void]) 68 (values 1 2)))) 69 70(test 'c (#%plain-lambda () 'a (define-values (x) 'b) 'c)) 71 72(test '(quote a) 'quote (quote 'a)) 73(test '(quote a) 'quote ''a) 74(syntax-test #'quote) 75(syntax-test #'(quote)) 76(syntax-test #'(quote 1 2)) 77 78(test 12 (if #f + *) 3 4) 79(syntax-test #'(+ 3 . 4)) 80(syntax-test #'(apply + 1 . 2)) 81 82(test 8 (lambda (x) (+ x x)) 4) 83(define reverse-subtract 84 (lambda (x y) (- y x))) 85(test 3 reverse-subtract 7 10) 86(define add4 87 (let ((x 4)) 88 (lambda (y) (+ x y)))) 89(test 10 add4 6) 90(test (letrec([x x]) x) 'lambda (let ([x (lambda () (define d d) d)]) (x))) 91(test (letrec([x x]) x) 'lambda ((lambda () (define d d) d))) 92(test '(3 4 5 6) (lambda x x) 3 4 5 6) 93(test '(5 6) (lambda (x y . z) z) 3 4 5 6) 94(test 'second (lambda () (cons 'first 2) 'second)) 95(syntax-test #'lambda) 96(syntax-test #'(lambda)) 97(syntax-test #'(lambda x)) 98(syntax-test #'(lambda ())) 99(syntax-test #'(lambda () (begin))) 100(syntax-test #'(lambda . x)) 101(syntax-test #'(lambda x . x)) 102(syntax-test #'(lambda x . 5)) 103(syntax-test #'(lambda ((x)) x)) 104(syntax-test #'(lambda 5 x)) 105(syntax-test #'(lambda (5) x)) 106(syntax-test #'(lambda (x (y)) x)) 107(syntax-test #'(lambda (x . 5) x)) 108(syntax-test #'(lambda (x) x . 5)) 109 110(let ([f 111 (case-lambda 112 [() 'zero] 113 [(x) (cons 1 1) 'one] 114 [(x y) 'two] 115 [(x y z . rest) 'three+] 116 [x 'bad])] 117 [g 118 (case-lambda 119 [(x y z) 'three] 120 [(x y) (cons 2 2) 'two] 121 [(x) 'one] 122 [() 'zero] 123 [x (cons 0 'more!) 'more])] 124 [h 125 (case-lambda 126 [(x y) 'two] 127 [(x y z w) 'four])]) 128 (test 'zero f) 129 (test 'one f 1) 130 (test 'two f 1 2) 131 (test 'three+ f 1 2 3) 132 (test 'three+ f 1 2 3 4) 133 (test 'three+ f 1 2 3 4 5 6 7 8 9 10) 134 135 (test 'zero g) 136 (test 'one g 1) 137 (test 'two g 1 2) 138 (test 'three g 1 2 3) 139 (test 'more g 1 2 3 4 5 6 7 8 9 10) 140 141 (test 'two h 1 2) 142 (test 'four h 1 2 3 4) 143 (let ([h '(case-lambda 144 [(x y) 'two] 145 [(x y z w) 'four])]) 146 (error-test (datum->syntax #f (list h) #f) arity?) 147 (error-test (datum->syntax #f (list* h '(1)) #f) arity?) 148 (error-test (datum->syntax #f (list* h '(1 2 3)) #f) arity?) 149 (error-test (datum->syntax #f (list* h '(1 2 3 4 5 6)) #f) arity?))) 150 151(error-test #'((case-lambda)) arity?) 152 153(syntax-test #'case-lambda) 154(syntax-test #'(case-lambda . 1)) 155(syntax-test #'(case-lambda [])) 156(syntax-test #'(case-lambda 1)) 157(syntax-test #'(case-lambda x)) 158(syntax-test #'(case-lambda [x])) 159(syntax-test #'(case-lambda [x 8][y])) 160(syntax-test #'(case-lambda [x][y 9])) 161(syntax-test #'(case-lambda [8 8])) 162(syntax-test #'(case-lambda [((x)) 8])) 163(syntax-test #'(case-lambda [(8) 8])) 164(syntax-test #'(case-lambda [(x . 9) 8])) 165(syntax-test #'(case-lambda [x . 8])) 166(syntax-test #'(case-lambda [(x) . 8])) 167(syntax-test #'(case-lambda . [(x) 8])) 168(syntax-test #'(case-lambda [(x) 8] . y)) 169(syntax-test #'(case-lambda [(x) 8] . [y 7])) 170(syntax-test #'(case-lambda [(x) 8] [8 7])) 171(syntax-test #'(case-lambda [(x) 8] [((y)) 7])) 172(syntax-test #'(case-lambda [(x) 8] [(8) 7])) 173(syntax-test #'(case-lambda [(x) 8] [(y . 8) 7])) 174(syntax-test #'(case-lambda [(x) 8] [y . 7])) 175(syntax-test #'(case-lambda [(x) 8] [(y) . 7])) 176(syntax-test #'(case-lambda [(x x) 8] [(y) 7])) 177(syntax-test #'(case-lambda [(x . x) 8] [(y) 7])) 178(syntax-test #'(case-lambda [(y) 7] [(x x) 8])) 179(syntax-test #'(case-lambda [(y) 7] [(x . x) 8])) 180 181(test 'yes 'if (if (> 3 2) 'yes 'no)) 182(test 'no 'if (if (> 2 3) 'yes 'no)) 183(test '1 'if (if (> 3 2) (- 3 2) (+ 3 2))) 184(test-values '(1 2) (lambda () (if (cons 1 2) (values 1 2) 0))) 185(test-values '(1 2) (lambda () (if (not (cons 1 2)) 0 (values 1 2)))) 186(syntax-test #'if) 187(syntax-test #'(if)) 188(syntax-test #'(if . #t)) 189(syntax-test #'(if #t . 1)) 190(syntax-test #'(if #t 1 . 2)) 191(syntax-test #'(if #t)) 192(syntax-test #'(if #t 1)) 193(syntax-test #'(if #t 1 2 3)) 194(syntax-test #'(if #t 1 2 . 3)) 195(error-test #'(if (values 1 2) 3 4) arity?) 196 197(test (void) 'when (when (> 1 2) 0)) 198(test (void) 'when (when (> 1 2) (cons 1 2) 0)) 199(test 0 'when (when (< 1 2) 0)) 200(test 0 'when (when (< 1 2) (cons 1 2) 0)) 201(test-values '(0 10) (lambda () (when (< 1 2) (values 0 10)))) 202(syntax-test #'when) 203(syntax-test #'(when)) 204(syntax-test #'(when . 1)) 205(syntax-test #'(when 1)) 206(syntax-test #'(when 1 . 2)) 207(error-test #'(when (values 1 2) 0) arity?) 208 209(test (void) 'unless (unless (< 1 2) 0)) 210(test (void) 'unless (unless (< 1 2) (cons 1 2) 0)) 211(test 0 'unless (unless (> 1 2) 0)) 212(test 0 'unless (unless (> 1 2) (cons 1 2) 0)) 213(test-values '(0 10) (lambda () (unless (> 1 2) (values 0 10)))) 214(syntax-test #'unless) 215(syntax-test #'(unless)) 216(syntax-test #'(unless . 1)) 217(syntax-test #'(unless 1)) 218(syntax-test #'(unless 1 . 2)) 219(error-test #'(unless (values 1 2) 0) arity?) 220 221(define x 2) 222(test 3 'define (+ x 1)) 223(set! x 4) 224(test 5 'set! (+ x 1)) 225(syntax-test #'set!) 226(syntax-test #'(set!)) 227(syntax-test #'(set! x)) 228(syntax-test #'(set! x 1 2)) 229(syntax-test #'(set! 1 2)) 230(syntax-test #'(set! (x) 1)) 231(syntax-test #'(set! . x)) 232(syntax-test #'(set! x . 1)) 233(syntax-test #'(set! x 1 . 2)) 234 235(define (set!-not-ever-defined) (set! not-ever-defined (add1 not-ever-defined))) 236(err/rt-test (set!-not-ever-defined) exn:fail:contract:variable?) 237 238(set!-values (x) 9) 239(test 9 'set!-values x) 240(test (void) 'set!-values (set!-values () (values))) 241(syntax-test #'set!-values) 242(syntax-test #'(set!-values)) 243(syntax-test #'(set!-values . x)) 244(syntax-test #'(set!-values x)) 245(syntax-test #'(set!-values 8)) 246(syntax-test #'(set!-values (x))) 247(syntax-test #'(set!-values (x) . 0)) 248(syntax-test #'(set!-values x 0)) 249(syntax-test #'(set!-values (x . y) 0)) 250(syntax-test #'(set!-values (x . 8) 0)) 251(syntax-test #'(set!-values (x 8) 0)) 252(syntax-test #'(set!-values (x) 0 1)) 253(syntax-test #'(set!-values (x) 0 . 1)) 254(syntax-test #'(set!-values (x x) 0)) 255(syntax-test #'(set!-values (x y x) 0)) 256(syntax-test #'(set!-values (y x x) 0)) 257 258(error-test #'(set!-values () 1) arity?) 259(error-test #'(set!-values () (values 1 2)) arity?) 260(error-test #'(set!-values (x) (values)) arity?) 261(error-test #'(set!-values (x) (values 1 2)) arity?) 262(error-test #'(set!-values (x y) 1) arity?) 263(error-test #'(set!-values (x y) (values 1 2 3)) arity?) 264 265(error-test #'(set! unbound-variable 5) exn:fail:contract:variable?) 266 267(test 'greater 'cond (cond ((> 3 2) 'greater) 268 ((< 3 2) 'less))) 269(test 'equal 'cond (cond ((> 3 3) 'greater) 270 ((< 3 3) 'less) 271 (else 'equal))) 272(test 2 'cond (cond ((assv 'b '((a 1) (b 2))) => cadr) 273 (else #f))) 274(test #f 'cond (cond ((assv 'z '((a 1) (b 2))) => cadr) 275 (else #f))) 276(syntax-test #'(cond ((assv 'z '((a 1) (b 2))) => cadr) 277 (else 8) 278 (else #f))) 279(test #f 'cond (let ([else #f]) 280 (cond ((assv 'z '((a 1) (b 2))) => cadr) 281 (else 8) 282 (#t #f)))) 283(test 'second 'cond (cond ((< 1 2) (cons 1 2) 'second))) 284(test 'second-again 'cond (cond ((> 1 2) 'ok) (else (cons 1 2) 'second-again))) 285(test 1 'cond (cond (1))) 286(test 1 'cond (cond (#f) (1))) 287(test 1 'cond (cond (#f 7) (1))) 288(test 2 'cond (cond (#f 7) (1 => add1))) 289(test add1 'cond (let ([=> 9]) (cond (#f 7) (1 => add1)))) 290(non-z '(test 0 'case (case (* 2 3) 291 (6 0) 292 (else 7)))) 293(test 'composite 'case (case (* 2 3) 294 ((2 3 5 7) 'prime) 295 ((1 4 6 8 9) 'composite))) 296(test 'consonant 'case (case (car '(c d)) 297 ((a e i o u) 'vowel) 298 ((w y) 'semivowel) 299 (else 'consonant))) 300(test 'second 'case (case 10 301 [(10) (cons 1 2) 'second] 302 [else 5])) 303(test 'second-again 'case (case 11 304 [(10) (cons 1 2) 'second] 305 [else (cons 1 2) 'second-again])) 306(test-values '(10 9) (lambda () 307 (cond 308 [(positive? 0) 'a] 309 [(positive? 10) (values 10 9)] 310 [else #f]))) 311(test-values '(10 9) (lambda () 312 (case (string->symbol "hello") 313 [(bye) 'a] 314 [(hello) (values 10 9)] 315 [else #f]))) 316(error-test #'(cond [(values 1 2) 8]) arity?) 317(error-test #'(case (values 1 2) [(a) 8]) arity?) 318(syntax-test #'(case 1 []) #rx"ill-formed clause") 319(syntax-test #'(case 1 [(y) 5] []) #rx"ill-formed clause") 320(syntax-test #'(case 1 [x]) #rx"not a datum sequence") 321(syntax-test #'(case 1 [(y) 5] [x]) #rx"not a datum sequence") 322(syntax-test #'(case 1 [(y) 5] [x x]) #rx"not a datum sequence") 323(syntax-test #'(case 1 [x x]) #rx"not a datum sequence") 324(syntax-test #'(case 1 [(x)]) #rx"missing expression after datum sequence") 325(syntax-test #'(case 1 [(y) 5] [(x)]) #rx"missing expression after datum sequence") 326(syntax-test #'(case 1 [(x) . 8]) #rx"illegal use of `.'") 327(syntax-test #'(case 1 [(x) 10] . 9) #rx"illegal use of `.'") 328 329;; test larger `case' dispatches to trigger for binary-search 330;; and hash-table-based dispatch: 331(let () 332 (define (f x) 333 (case x 334 [(1003) 'even-further] 335 [(0 -1 -2) 'low] 336 [(1) 'one] 337 [(2 3 4 5 6) 'middle] 338 [(100) 'super] 339 [(7 8 9 10 11) 'upper] 340 [(1001) 'youch] 341 [(12) 'high] 342 [(1002) 'further] 343 [(13) 'extreme] 344 [(14) 'more])) 345 (test 'low f -2) 346 (test 'low f -1) 347 (test 'low f 0) 348 (test 'one f 1) 349 (test 'middle f 2) 350 (test 'middle f 3) 351 (test 'middle f 4) 352 (test 'middle f 5) 353 (test 'middle f 6) 354 (test 'upper f 7) 355 (test 'upper f 8) 356 (test 'upper f 9) 357 (test 'upper f 10) 358 (test 'upper f 11) 359 (test 'high f 12) 360 (test 'extreme f 13) 361 (test 'more f 14) 362 (test 'super f 100) 363 (test 'youch f 1001) 364 (test 'further f 1002) 365 (test 'even-further f 1003) 366 (test (void) f 1004) 367 (test (void) f 104) 368 (test (void) f -104)) 369 370(let () 371 (define (f x) 372 (case x 373 [(#\u1003) 'even-further] 374 [(#\u0) 'low] 375 [(#\u1) 'one] 376 [(#\u2 #\u3 #\u4 #\u5 #\u6) 'middle] 377 [(#\u100) 'super] 378 [(#\u7 #\u8 #\u9 #\u10 #\u11) 'upper] 379 [(#\u1001) 'youch] 380 [(#\u12) 'high] 381 [(#\u1002) 'further] 382 [(#\u13) 'extreme] 383 [(#\u14) 'more])) 384 (test 'low f #\u0) 385 (test 'one f #\u1) 386 (test 'middle f #\u2) 387 (test 'middle f #\u3) 388 (test 'middle f #\u4) 389 (test 'middle f #\u5) 390 (test 'middle f #\u6) 391 (test 'upper f #\u7) 392 (test 'upper f #\u8) 393 (test 'upper f #\u9) 394 (test 'upper f #\u10) 395 (test 'upper f #\u11) 396 (test 'high f #\u12) 397 (test 'extreme f #\u13) 398 (test 'more f #\u14) 399 (test 'super f #\u100) 400 (test 'youch f #\u1001) 401 (test 'further f #\u1002) 402 (test 'even-further f #\u1003) 403 (test (void) f #\u1004) 404 (test (void) f #\u104)) 405 406(let () 407 (define (f x) 408 (case x 409 [(low) 0] 410 [(one) 1] 411 [(middle) 2] 412 [(upper #t) 3] 413 [(high big up-there more) 4] 414 [(extreme massive huge #f gigantic) 5])) 415 (test 0 f 'low) 416 (test 1 f 'one) 417 (test 2 f 'middle) 418 (test 3 f 'upper) 419 (test 3 f #t) 420 (test 4 f 'high) 421 (test 4 f 'big) 422 (test 4 f 'up-there) 423 (test 4 f 'more) 424 (test 5 f 'extreme) 425 (test 5 f 'massive) 426 (test 5 f 'huge) 427 (test 5 f #f) 428 (test 5 f 'gigantic) 429 (test (void) f 'gigante) 430 (test (void) f 0)) 431 432(let () 433 ;; This test relies on interning of string literals. 434 (define (f x) 435 (case x 436 [("low") 0] 437 [("one") 1] 438 [("middle") 2] 439 [("upper" #t) 3] 440 [("high" "big" "up-there" "more") 4] 441 [("extreme" "massive" "huge" "gigantic" #f) 5])) 442 (test 0 f "low") 443 (test 1 f "one") 444 (test 2 f "middle") 445 (test 3 f "upper") 446 (test 3 f #t) 447 (test 4 f "high") 448 (test 4 f "big") 449 (test 4 f "up-there") 450 (test 4 f "more") 451 (test 5 f "extreme") 452 (test 5 f "massive") 453 (test 5 f "huge") 454 (test 5 f #f) 455 (test 5 f "gigantic") 456 (test (void) f "gigante") 457 (test (void) f 'gigante) 458 (test (void) f 0)) 459 460(let () 461 ;; This test uses string-copy to avoid interning string literals. 462 (define (f x) 463 (define y 464 (if (string? x) 465 (string-copy x) 466 x)) 467 (case y 468 [("low") 0] 469 [("one") 1] 470 [("middle") 2] 471 [("upper" #t) 3] 472 [("high" "big" "up-there" "more") 4] 473 [("extreme" "massive" "huge" "gigantic" #f) 5])) 474 (test 0 f "low") 475 (test 1 f "one") 476 (test 2 f "middle") 477 (test 3 f "upper") 478 (test 3 f #t) 479 (test 4 f "high") 480 (test 4 f "big") 481 (test 4 f "up-there") 482 (test 4 f "more") 483 (test 5 f "extreme") 484 (test 5 f "massive") 485 (test 5 f "huge") 486 (test 5 f #f) 487 (test 5 f "gigantic") 488 (test (void) f "gigante") 489 (test (void) f 'gigante) 490 (test (void) f 0)) 491 492(let () 493 (define (f x) 494 (case x 495 [("zero" #"zero" (z . 0) (z e r o) #(z e r o) #&zero 496 #hash((z . "z") (e . "e") (r . "r") (o . "o")) 497 #s(z e r o)) 498 0] 499 [("one" #"one" (o . 1) (o n e) #(o n e) #&one 500 #hash((o . "o") (n . "n") (e . "e")) 501 #s(o n e)) 502 1] 503 [("two" #"two" (t . 2) (t w o) #(t w o) #&two 504 #hash((t . "t") (w . "w") (o . "o")) 505 #s(t w o)) 506 2] 507 [("three" #"three" (t . 3) (t h r e e) #(t h r e e) #&three 508 #hash((t . "t") (h . "h") (r . "e") (e . "e") (e . "e")) 509 #s(t h r e e)) 510 3] 511 [("four" #"four" (f . 4) (f o u r) #(f o u r) #&four 512 #hash((f . "f") (o . "o") (u . "u") (r . "r")) 513 #s(f o u r)) 514 4] 515 [("five" #"five" (f . 5) (f i v e) #(f i v e) #&five 516 #hash((f . "f") (i . "i") (v . "v") (e . "e")) 517 #s(f i v e)) 518 5] 519 [("six" #"six" (s . 6) (s i x) #(s i x) #&six 520 #hash((s . "s") (i . "i") (x . "x")) 521 #s(s i x)) 522 6] 523 [("seven" #"seven" (s . 7) (s e v e n) #(s e v e n) #&seven 524 #hash((s . "s") (e . "e") (v . "v") (e . "e") (n . "n")) 525 #s(s e v e n)) 526 7] 527 [("eight" #"eight" (e . 8) (e i g h t) #(e i g h t) #&eight 528 #hash((e . "e") (i . "i") (g . "g") (h . "h") (t . "t")) 529 #s(e i g h t)) 530 8])) 531 (test 8 f "eight") 532 (test 7 f #"seven") 533 (test 6 f (cons 's 6)) 534 (test 5 f '(f i v e)) 535 (test 4 f '#(f o u r)) 536 (test 3 f (box 'three)) 537 (test 2 f (hash 't "t" 'w "w" 'o "o")) 538 (test 1 f #s(o n e)) 539 (test (void) f #f)) 540 541(test #t 'and (and (= 2 2) (> 2 1))) 542(test #f 'and (and (= 2 2) (< 2 1))) 543(test '(f g) 'and (and 1 2 'c '(f g))) 544(test #t 'and (and)) 545(test-values '(1 12) (lambda () (and (cons 1 2) (values 1 12)))) 546(test #t 'or (or (= 2 2) (> 2 1))) 547(test #t 'or (or (= 2 2) (< 2 1))) 548(test #f 'or (or #f #f #f)) 549(test #f 'or (or)) 550(test '(b c) 'or (or (memq 'b '(a b c)) (+ 3 0))) 551(test-values '(1 12) (lambda () (or (not (cons 1 2)) (values 1 12)))) 552(syntax-test #'(cond #t)) 553(syntax-test #'(cond ()) ) 554(syntax-test #'(cond (1 =>)) ) 555(syntax-test #'(cond (1 => 3 4)) ) 556(syntax-test #'(cond . #t)) 557(syntax-test #'(cond (#t . 1))) 558(syntax-test #'(cond (#t 1) #f)) 559(syntax-test #'(cond (#t 1) . #f)) 560(error-test #'(cond ((values #t #f) 1)) arity?) 561(syntax-test #'case) 562(syntax-test #'(case)) 563(syntax-test #'(case 0 #t)) 564(syntax-test #'(case . 0)) 565(syntax-test #'(case 0 . #t)) 566(syntax-test #'(case 0 (0 #t))) 567(syntax-test #'(case 0 ())) 568(syntax-test #'(case 0 (0))) 569(syntax-test #'(case 0 (0 . 8))) 570(syntax-test #'(case 0 ((0 . 1) 8))) 571(syntax-test #'(case 0 (0 8) #f)) 572(syntax-test #'(case 0 (0 8) . #f)) 573(syntax-test #'(case 0 (else 1) (else 2))) 574(syntax-test #'(case 0 ((0) =>))) 575(syntax-test #'=>) 576(syntax-test #'else) 577(syntax-test #'(and . 1)) 578(syntax-test #'(and 1 . 2)) 579(syntax-test #'(or . 1)) 580(syntax-test #'(or 1 . 2)) 581(error-test #'(and #t (values 1 2) 8) arity?) 582(error-test #'(or #f (values 1 2) 8) arity?) 583 584(test 6 'let (let ((x 2) (y 3)) (* x y))) 585(test 'second 'let (let ((x 2) (y 3)) (* x y) 'second)) 586(test 6 'let-values (let-values (((x) 2) ((y) 3)) (* x y))) 587(test 6 'let-values (let-values (((x y) (values 2 3))) (* x y))) 588(test 35 'let (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x)))) 589(test 35 'let-values (let-values (((x y) (values 2 3))) (let-values (((x) 7) ((z) (+ x y))) (* z x)))) 590(test 70 'let* (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x)))) 591(test 70 'let*-values (let ((x 2) (y 3)) (let*-values (((x) 7) ((z) (+ x y))) (* z x)))) 592(test #t 'letrec (letrec ((-even? 593 (lambda (n) (if (zero? n) #t (-odd? (- n 1))))) 594 (-odd? 595 (lambda (n) (if (zero? n) #f (-even? (- n 1)))))) 596 (-even? 88))) 597(test #t 'letrec-values (letrec-values (((-even? -odd?) 598 (values 599 (lambda (n) (if (zero? n) #t (-odd? (- n 1)))) 600 (lambda (n) (if (zero? n) #f (-even? (- n 1))))))) 601 (-even? 88))) 602(define x 34) 603(test 5 'let (let ((x 3)) (define x 5) x)) 604(test 5 'let (let ((x 3)) (define-values (x w) (values 5 8)) x)) 605(test 34 'let x) 606(test 6 'let (let () (define x 6) x)) 607(test 34 'let x) 608(test 7 'let* (let* ((x 3)) (define x 7) x)) 609(test 34 'let* x) 610(test 8 'let* (let* () (define x 8) x)) 611(test 34 'let* x) 612(test 9 'letrec (letrec () (define x 9) x)) 613(test 34 'letrec x) 614(test 10 'letrec (letrec ((x 3)) (define x 10) x)) 615(test 34 'letrec x) 616(teval '(test 5 'letrec (letrec ((x 5)(y x)) y))) 617(test 3 'let (let ((y 'apple) (x 3) (z 'banana)) x)) 618(test 3 'let* (let* ((y 'apple) (x 3) (z 'banana)) x)) 619(test 3 'letrec (letrec ((y 'apple) (x 3) (z 'banana)) x)) 620(test 3 'let* (let* ((x 7) (y 'apple) (z (set! x 3))) x)) 621(test 3 'let* (let* ((x 7) (y 'apple) (z (if (not #f) (set! x 3) #f))) x)) 622(test 3 'let* (let* ((x 7) (y 'apple) (z (if (not #t) #t (set! x 3)))) x)) 623(test 3 'let-values (let-values (((y x z) (values 'apple 3 'banana))) x)) 624(test 3 'let*-values (let*-values (((y x z) (values 'apple 3 'banana))) x)) 625(test 3 'letrec-values (letrec-values (((y x z) (values 'apple 3 'banana))) x)) 626(test 3 'let*-values (let*-values (((x y) (values 7 'apple)) ((z) (set! x 3))) x)) 627(test 3 'let*-values (let*-values (((x y) (values 7 'apple)) ((z) (if (not #f) (set! x 3) #f))) x)) 628(test 3 'let*-values (let*-values (((x y) (values 7 'apple)) ((z) (if (not #t) #t (set! x 3)))) x)) 629(test 1 'named-let-scope (let ([f add1]) (let f ([n (f 0)]) n))) 630 631(test-values '(3 4) (lambda () (let ([x 3][y 4]) (values x y)))) 632(test-values '(3 -4) (lambda () (let loop ([x 3][y -4]) (values x y)))) 633(test-values '(3 14) (lambda () (let* ([x 3][y 14]) (values x y)))) 634(test-values '(3 24) (lambda () (letrec ([x 3][y 24]) (values x y)))) 635(test-values '(3 54) (lambda () (let-values ([(x y) (values 3 54)]) (values x y)))) 636(test-values '(3 64) (lambda () (let*-values ([(x y) (values 3 64)]) (values x y)))) 637(test-values '(3 74) (lambda () (letrec-values ([(x y) (values 3 74)]) (values x y)))) 638 639(test 'one 'let-values (let-values ([() (values)]) 'one)) 640(test 'two 'let*-values (let*-values ([() (values)]) 'two)) 641(test 'three 'letrec-values (letrec-values ([() (values)]) 'three)) 642(test 'onex 'let-values (let-values ([() (values)][() (values)]) 'onex)) 643(test 'twox 'let*-values (let*-values ([() (values)][() (values)]) 'twox)) 644(test 'threex 'letrec-values (letrec-values ([() (values)][() (values)]) 'threex)) 645 646(letrec ([undef undef]) 647 (test (list 1 undef undef) 'no-split-letrec (letrec-values ([(a b c) (values 1 a b)]) (list a b c)))) 648 649(test '(10 11) 'letrec-values (letrec-values ([(names kps) 650 (letrec ([oloop 10]) 651 (values oloop (add1 oloop)))]) 652 (list names kps))) 653 654(define (error-test-let/no-* expr) 655 (syntax-test (datum->syntax #f (cons 'let expr) #f)) 656 (syntax-test (datum->syntax #f (cons 'let (cons 'name expr)) #f)) 657 (syntax-test (datum->syntax #f (cons 'letrec expr) #f))) 658(define (error-test-let expr) 659 (error-test-let/no-* expr) 660 (syntax-test (datum->syntax #f (cons 'let* expr) #f))) 661(error-test-let #'x) 662(error-test-let #'(x)) 663(error-test-let #'(())) 664(error-test-let #'(x ())) 665(syntax-test #'(let* x () 1)) 666(syntax-test #'(letrec x () 1)) 667(error-test-let #'(x . 1)) 668(error-test-let #'(() . 1)) 669(error-test-let #'(((x 1)))) 670(error-test-let #'(((x 1)) . 1)) 671(error-test-let #'(((x . 1)) 1)) 672(error-test-let #'(((1 1)) 1)) 673(error-test-let #'(((x 1) 1) 1)) 674(error-test-let #'(((x 1) . 1) 1)) 675(error-test-let #'(((x 1 1)) 1)) 676(error-test-let #'(((x 1 1)) 1)) 677(error-test-let #'(((x 1)) 1 . 2)) 678(error-test-let/no-* #'(((x 1) (x 2)) 1)) 679(error-test-let/no-* #'(((x 1) (y 3) (x 2)) 1)) 680(error-test-let/no-* #'(((y 3) (x 1) (x 2)) 1)) 681(error-test-let/no-* #'(((x 1) (x 2) (y 3)) 1)) 682(test 5 'let* (let* ([x 4][x 5]) x)) 683(error-test-let #'(() (define x 10))) 684(error-test-let #'(() (define x 10) (define y 20))) 685 686(define (do-error-test-let-values/no-* expr syntax-test) 687 (syntax-test (datum->syntax #f (cons 'let-values expr) #f)) 688 (syntax-test (datum->syntax #f (cons 'letrec-values expr) #f))) 689(define (do-error-test-let-values expr syntax-test) 690 (do-error-test-let-values/no-* expr syntax-test) 691 (syntax-test (datum->syntax #f (cons 'let*-values expr) #f))) 692(define (error-test-let-values/no-* expr) 693 (do-error-test-let-values/no-* expr syntax-test)) 694(define (error-test-let-values expr) 695 (do-error-test-let-values expr syntax-test)) 696(error-test-let-values #'x) 697(error-test-let-values #'(x)) 698(error-test-let-values #'(())) 699(error-test-let-values #'(x ())) 700(syntax-test #'(let*-values x () 1)) 701(syntax-test #'(letrec-values x () 1)) 702(error-test-let-values #'(x . 1)) 703(error-test-let-values #'(() . 1)) 704(error-test-let-values #'((((x) 1)))) 705(error-test-let-values #'((((x) 1)) . 1)) 706(error-test-let-values #'((((x) . 1)) 1)) 707(error-test-let-values #'((((1) 1)) 1)) 708(error-test-let-values #'((((x 1) 1)) 1)) 709(error-test-let-values #'((((1 x) 1)) 1)) 710(error-test-let-values #'((((x) 1) . 1) 1)) 711(error-test-let-values #'((((x) 1 1)) 1)) 712(error-test-let-values #'((((x . y) 1)) 1)) 713(error-test-let-values #'((((x . 1) 1)) 1)) 714(error-test-let-values #'((((x) 1)) 1 . 2)) 715(error-test-let-values #'((((x x) 1)) 1)) 716(error-test-let-values #'((((y) 0) ((x x) 1)) 1)) 717(error-test-let-values #'((((x x) 1) ((y) 0)) 1)) 718(error-test-let-values/no-* #'((((x) 1) ((x) 2)) 1)) 719(error-test-let-values/no-* #'((((x) 1) ((y) 3) ((x) 2)) 1)) 720(error-test-let-values/no-* #'((((y) 3) ((x) 1) ((x) 2)) 1)) 721(error-test-let-values/no-* #'((((x) 1) ((x) 2) ((y) 3)) 1)) 722(test 5 'let* (let*-values ([(x) 4][(x) 5]) x)) 723 724(do-error-test-let-values #'((((x y) 1)) 1) (lambda (x) (error-test x arity?))) 725(do-error-test-let-values #'((((x) (values 1 2))) 1) (lambda (x) (error-test x arity?))) 726(do-error-test-let-values #'(((() (values 1))) 1) (lambda (x) (error-test x arity?))) 727(do-error-test-let-values #'((((x) (values))) 1) (lambda (x) (error-test x arity?))) 728 729(test 5 'embedded (let () (define y (lambda () x)) (define x 5) (y))) 730 731(let ([wrap (lambda (body) 732 (syntax-test (datum->syntax #f `(let () ,@body) #f)) 733 (syntax-test (datum->syntax #f `(let () (begin ,@body)) #f)))]) 734 (wrap '((define x 7) (define x 8) x)) 735 (wrap '((define 3 8) x)) 736 (wrap '((define-values x 8) x))) 737 738(let ([wrap 739 (lambda (val body) 740 (teval `(test ,val 'let-begin (let () ,@body))) 741 (teval `(test ,val 'let-begin (let ([xyzw 12]) ,@body))) 742 (teval `(test ,val (lambda () ,@body))) 743 (teval `(test ,val 'parameterize-begin 744 (parameterize () ,@body))) 745 (teval `(test ,val 'parameterize-begin 746 (parameterize ([current-directory (current-directory)]) 747 ,@body))) 748 (teval `(test ,val 'with-handlers-begin 749 (with-handlers () ,@body))) 750 (teval `(test ,val 'with-handlers-begin 751 (with-handlers ([void void]) ,@body))) 752 (teval `(test ,val 'when-begin (when (positive? 1) ,@body))) 753 (teval `(test ,val 'unless-begin (unless (positive? -1) ,@body))) 754 (teval `(test ,val 'cons-begin (cond [(positive? 1) ,@body][else #f]))) 755 (teval `(test ,val 'cons-else-begin (cond [(positive? -1) 0][else ,@body]))) 756 (teval `(test ,val 'case-begin (case (positive? 1) [(#t) ,@body][else -12]))) 757 (teval `(test ,val 'cond-only-begin (cond [#t ,@body]))) 758 (syntax-test (datum->syntax #f `(do ((x 1)) (#t ,@body) ,@body) #f)) 759 (syntax-test (datum->syntax #f `(begin0 12 ,@body) #f)))]) 760 (wrap 5 '((begin (define x 5)) x)) 761 (wrap 5 '((begin (define x 5) x))) 762 (wrap 15 '((begin (define x 5)) (begin (define y (+ x 10)) y))) 763 (wrap 13 '((begin) 13)) 764 (wrap 7 '((begin) (begin) (begin (define x 7) (begin) x))) 765 (wrap 7 '((begin (begin (begin (define x 7) (begin) x)))))) 766 767(define x 0) 768(define (test-begin bg nested-bg) 769 (let* ([make-args 770 (lambda (bg b) 771 (if (eq? bg 'begin) 772 b 773 (let* ([len (length b)] 774 [last (list-ref b (sub1 len))]) 775 (cons last 776 (let loop ([l b]) 777 (if (null? (cdr l)) 778 null 779 (cons (car l) (loop (cdr l)))))))))] 780 [test-bg 781 (lambda (v b) 782 (let* ([args (make-args bg b)] 783 [expr (cons bg args)]) 784 (printf "~s:\n" expr) 785 (teval `(test ,v (quote ,bg) ,expr))))] 786 [make-bg 787 (lambda (b) 788 (cons nested-bg (make-args nested-bg b)))] 789 [make-test-bg-d 790 (lambda (bg) 791 (lambda (v1 v2 b) 792 (test-bg (if (eq? bg 'begin) 793 v1 794 v2) 795 b)))] 796 [test-bg-d (make-test-bg-d bg)] 797 [test-bg-d2 (make-test-bg-d nested-bg)]) 798 (teval '(set! x 0)) 799 (test-bg-d 6 1 '((set! x 5) (+ x 1))) 800 (test-bg 5 '(5)) 801 (test-bg 3 '(2 3)) 802 (test-bg 3 `(2 (,bg 3))) 803 (test-bg 3 `(,(make-bg '(2)) ,(make-bg '(3)))) 804 (test-bg-d 7 6 '((set! x 6) 'a (+ x 1))) 805 (test-bg ''w '((set! x 6) 'a (+ x 1) 'w)) 806 (test-bg-d 8 7 '('b (set! x 7) (+ x 1))) 807 (test-bg-d 9 8 '('b (set! x 8) 'a (+ x 1))) 808 (test-bg ''z '('b (set! x 8) 'a (+ x 1) 'z)) 809 (test-bg-d 7 9 `(,(make-bg '((set! x 6) 'a)) (+ x 1))) 810 (test-bg 10 `(,(make-bg '((set! x 60) 'a)) 10)) 811 (teval '(test 60 'x x)) 812 (test-bg 10 `(,(make-bg '((set! x 65) 'a)) (add1 20) 10)) 813 (teval '(test 65 'x x)) 814 (test-bg ''a `(10 ,(make-bg '((set! x 66) 'a)))) 815 (teval '(test 66 'x x)) 816 (test-bg ''a `(10 (add1 32) ,(make-bg '((set! x 67) 'a)))) 817 (teval '(test 67 'x x)) 818 (teval '(set! x 6)) 819 (test-bg-d 8 7 `(,(make-bg '('b (set! x 7) 'a)) (+ x 1))) 820 (test-bg-d 9 8 `(,(make-bg '('b (set! x 8))) ,(make-bg '('a (+ x 1))))) 821 (test-bg-d2 10 9 `(,(make-bg `(,(make-bg `('b (set! x 9) ,(make-bg '('a (+ x 1))))))))) 822 (test-bg ''s `(,(make-bg `(,(make-bg `('b (set! x 9) ,(make-bg '('a (+ x 1) 's)))))))) 823 (test-bg ''t `(,(make-bg `(,(make-bg `('b (set! x 9) ,(make-bg '('a (+ x 1))))))) 't)) 824 (teval `(test 5 call-with-values (lambda () ,(make-bg '((values 1 2) (values 1 3 1)))) +)) 825 (syntax-test (datum->syntax #f `(,bg . 1) #f)) 826 (syntax-test (datum->syntax #f `(,bg 1 . 2) #f)))) 827 828(test-begin 'begin 'begin) 829(test-begin 'begin0 'begin) 830(test-begin 'begin0 'begin0) 831(test-begin 'begin 'begin0) 832 833(syntax-test #'(begin0)) 834(begin) ; must succeed, but we can't wrap it 835 836(test 4 'implicit-begin (let ([x 4][y 7]) 'y x)) 837(test 4 'implicit-begin (let ([x 4][y 7]) y x)) 838 839(test 5 'implicit-begin (let () (begin) 10 5)) 840 841(error-test #'(begin (define foo (let/cc k k)) (foo 10)) exn:application:type?) ; not exn:application:continuation? 842 843(define f-check #t) 844(define f (delay (begin (set! f-check #f) 5))) 845(test #t (lambda () f-check)) 846(test 5 force f) 847(test #f (lambda () f-check)) 848(test 5 force f) 849(define f-check-2 (delay (values 1 5))) 850(test-values '(1 5) (lambda () (force f-check-2))) 851(values 1 2) 852(test-values '(1 5) (lambda () (force f-check-2))) 853(syntax-test #'delay) 854(syntax-test #'(delay)) 855(syntax-test #'(delay . 1)) 856(syntax-test #'(delay 1 . 2)) 857 858(let ([p (delay/sync 12)] 859 [v #f]) 860 (thread (lambda () (set! v (force p)))) 861 (sync (system-idle-evt)) 862 (test 12 force p) 863 (test 12 values v) 864 (test (void) sync p) 865 (test (list (void)) sync (wrap-evt p list))) 866 867(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4)) 868(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name))) 869(test '(a 3 4 5 6 b) 'quasiquote `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) 870(test '((foo 7) . cons) 871 'quasiquote 872 `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))) 873(test '#(10 5 2 4 3 8) 'quasiquote `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8)) 874(test 5 'quasiquote `,(+ 2 3)) 875(test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f) 876 'quasiquote `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) 877(test '(a `(b ,x ,'y d) e) 'quasiquote 878 (let ((name1 'x) (name2 'y)) `(a `(b ,,name1 ,',name2 d) e))) 879(test '(list 3 4) 'quasiquote (quasiquote (list (unquote (+ 1 2)) 4))) 880(test '`(list ,(+ 1 2) 4) 'quasiquote '(quasiquote (list (unquote (+ 1 2)) 4))) 881(test '(()) 'qq `((,@'()))) 882(define x 5) 883(test '(quasiquote (unquote x)) 'qq ``,x) 884(test '(quasiquote (unquote 5)) 'qq ``,,x) 885(test '(quasiquote (unquote-splicing x)) 'qq ``,@x) 886(test '(quasiquote (unquote-splicing 5)) 'qq ``,@,x) 887(test '(quasiquote (quasiquote (quasiquote (unquote (unquote (unquote x)))))) 'qq ````,,,x) 888(test '(quasiquote (quasiquote (quasiquote (unquote (unquote (unquote 5)))))) 'qq ````,,,,x) 889 890(test '#hash() 'qq `#hash()) 891(test '#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3)) 892 'qq 893 `#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3))) 894(test '#hash(("apple" . 1) ("banana" . 2) ("coconut" . 3)) 895 'qq 896 `#hash(("apple" . ,1) ("banana" . ,(add1 1)) ("coconut" . ,(+ 1 2)))) 897(test '#hash(("foo" . (1 2 3 4 5))) 898 'qq 899 `#hash(("foo" . (1 2 ,(+ 1 2) 4 5)))) 900(test '#hash(("foo" . (1 2 (+ 1 2) 4 5))) 901 'qq 902 `#hash(("foo" . (1 2 (+ 1 2) 4 5)))) 903(test '#hash(("foo" . (1 2 3 4 5))) 904 'qq 905 `#hash(("foo" . (1 2 ,@(list 3 4 5))))) 906(test '#hash((,(read) . 1) (,(+ 1 2) . 3)) 907 'qq 908 `#hash((,(read) . 1) (,(+ 1 2) . ,(+ 1 2)))) 909(test '#hash((,(read) . 2)) 910 'qq 911 `#hash((,(read) . 1) (,(read) . 2))) 912(test '#hash(("moo" . 3) ("foo" . (1 2))) 913 'qq 914 `#hash(("moo" . ,(+ 1 2)) ("foo" . (1 2)))) 915(test '#hash(("moo" . (+ 1 2)) ("foo" . -1)) 916 'qq 917 `#hash(("moo" . (+ 1 2)) ("foo" . ,(- 1 2)))) 918(syntax-test #'`#hash(("foo" . ,@(list 1 2 3 4 5)))) 919(error-test #'(read (open-input-string "`#hash((foo ,@(list 1 2 3 4 5)))")) exn:fail:read?) 920 921(test '(quasiquote (unquote result)) 'qq `(quasiquote ,result)) 922(test (list 'quasiquote car) 'qq `(,'quasiquote ,car)) 923 924(syntax-test #'quasiquote) 925(syntax-test #'(quasiquote)) 926(syntax-test #'(quasiquote . 5)) 927(syntax-test #'(quasiquote 1 . 2)) 928(syntax-test #'(quasiquote 1 2)) 929(syntax-test #'(unquote 7)) 930(syntax-test #'(unquote-splicing 7)) 931 932(syntax-test #'`(1 . ,@5)) 933(test (cons 1 5) 'qq `(1 ,@5)) 934(error-test #'`(1 ,@5 2)) 935 936(define (qq-test e) 937 (syntax-test (datum->syntax #f e #f)) 938 (syntax-test (datum->syntax #f (list 'quasiquote e) #f)) 939 (syntax-test (datum->syntax #f (list 'quasiquote e) #f)) 940 (syntax-test (datum->syntax #f (list 'quasiquote (list 'quasiquote e)) #f)) 941 (syntax-test (datum->syntax #f (list 'quasiquote (list 'quasiquote (list 'unquote e))) #f)) 942 (syntax-test (datum->syntax #f (list 'quasiquote (list 'quasiquote (list 'unquote-splicing e))) #f))) 943(qq-test #'(unquote)) 944(qq-test #'(unquote 7 8 9)) 945(qq-test #'(unquote-splicing)) 946(qq-test #'(unquote-splicing 7 8 9)) 947 948(test '(unquote . 5) 'qq (quasiquote (unquote . 5))) 949(test '(unquote 1 . 5) 'qq (quasiquote (unquote 1 . 5))) 950(test '(unquote 1 2 . 5) 'qq (quasiquote (unquote 1 2 . 5))) 951 952(test '(unquote 1 2 7 . 5) 'qq (quasiquote (unquote 1 2 ,(+ 3 4) . 5))) 953(test '(unquote 1 2 (unquote (+ 3 4)) . 5) 'qq (quasiquote (unquote 1 2 ,',(+ 3 4) . 5))) 954 955(test '(1 2 3 4 . 5) 'qq `(1 ,@'(2 3 4) . 5)) 956 957(error-test #'`(10 ,(values 1 2)) arity?) 958(error-test #'`(10 ,@(values 1 2)) arity?) 959 960(define add3 (lambda (x) (+ x 3))) 961(test 6 'define (add3 3)) 962(define (add3 x) (+ x 3)) 963(test 6 'define (add3 3)) 964(define first car) 965(test 1 'define (first '(1 2))) 966(syntax-test #'define) 967(syntax-test #'(define)) 968(syntax-test #'(define . x)) 969(syntax-test #'(define x)) 970(syntax-test #'(define x . 1)) 971(syntax-test #'(define 1 2)) 972(syntax-test #'(define (1) 1)) 973(syntax-test #'(define (x 1) 1)) 974(syntax-test #'(define (x a a) 1)) 975(syntax-test #'(define ((x 1) a) 1)) 976(syntax-test #'(define ((x b b) a) 1)) 977(syntax-test #'(define x 1 . 2)) 978(syntax-test #'(define x 1 2)) 979 980(let () 981 (define ((f x) y z) (list x y z)) 982 (test '(1 2 3) (f 1) 2 3)) 983(let () 984 (define ((g a) a b) (list a b)) 985 (test '(2 3) (g 1) 2 3)) 986 987(define-values (add3) (lambda (x) (+ x 3))) 988(test 6 'define (add3 3)) 989(define-values (add3 another) (values (lambda (x) (+ x 3)) 9)) 990(test 6 'define (add3 3)) 991(test 9 'define another) 992(define-values (first second third) (values car cadr caddr)) 993(test 1 'define (first '(1 2))) 994(test 2 'define (second '(1 2))) 995(test 3 'define (third '(1 2 3))) 996(define-values () (values)) 997(syntax-test #'define-values) 998(syntax-test #'(define-values)) 999(syntax-test #'(define-values . x)) 1000(syntax-test #'(define-values x)) 1001(syntax-test #'(define-values (x))) 1002(syntax-test #'(define-values x . 1)) 1003(syntax-test #'(define-values (x) . 1)) 1004(syntax-test #'(define-values 1 2)) 1005(syntax-test #'(define-values (1) 2)) 1006(syntax-test #'(define-values (x 1) 1)) 1007(syntax-test #'(define-values (x . y) 1)) 1008(syntax-test #'(define-values (x) 1 . 2)) 1009(syntax-test #'(define-values (x) 1 2)) 1010(syntax-test #'(define-values (x x) 10)) 1011(syntax-test #'(define-values (x y x) 10)) 1012 1013(syntax-test #'((define x 2) 0 1)) 1014(syntax-test #'(+ (define x 2) 1)) 1015(syntax-test #'(if (define x 2) 0 1)) 1016(syntax-test #'(begin0 (define x 2))) 1017(syntax-test #'(begin0 (define x 2) 0)) 1018(syntax-test #'(begin0 0 (define x 2))) 1019(syntax-test #'(begin0 0 (define x 2) (define x 12))) 1020(syntax-test #'(let () (define x 2))) 1021(syntax-test #'(letrec () (define x 2))) 1022(syntax-test #'(lambda () (define x 2))) 1023(syntax-test #'(lambda () (void (define x 2)) 1)) 1024(syntax-test #'(cond [(< 2 3) (define x 2)] [else 5])) 1025(syntax-test #'(cond [else (define x 2)])) 1026 1027;; No good way to test in mzc: 1028(error-test #'(define x (values)) exn:application:arity?) 1029(error-test #'(define x (values 1 2)) exn:application:arity?) 1030(error-test #'(define-values () 3) exn:application:arity?) 1031(error-test #'(define-values () (values 1 3)) exn:application:arity?) 1032(error-test #'(define-values (x y) (values)) exn:application:arity?) 1033(error-test #'(define-values (x y) 3) exn:application:arity?) 1034(error-test #'(define-values (x y) (values 1 2 3)) exn:application:arity?) 1035 1036(begin (define ed-t1 1) (define ed-t2 2)) 1037(test 1 'begin-define ed-t1) 1038(test 2 'begin-define ed-t2) 1039(begin (begin (begin (begin 10 (define ed-t2.5 2.5) 12)))) 1040(test 2.5 'begin-define ed-t2.5) 1041(syntax-test #'(if (zero? 0) (define ed-t3 3) (define ed-t3 -3))) 1042(syntax-test #'(if #t (define ed-t3 3) (define ed-t3 -3))) 1043(syntax-test #'(if #f (define ed-t3 3) (define ed-t3 -3))) 1044 1045(test 45 'define 1046 (let ((x 5)) 1047 (define foo (lambda (y) (bar x y))) 1048 (define bar (lambda (a b) (+ (* a b) a))) 1049 (foo (+ x 3)))) 1050(define x 34) 1051(define (foo) (define x 5) x) 1052(test 5 foo) 1053(test 34 'define x) 1054(define foo (lambda () (define x 5) x)) 1055(test 5 foo) 1056(test 34 'define x) 1057(define (foo x) ((lambda () (define x 5) x)) x) 1058(test 88 foo 88) 1059(test 4 foo 4) 1060(test 34 'define x) 1061 1062(test 5 'define 1063 (let () 1064 (define x 5) 1065 (define define (lambda (a b) (+ a b))) 1066 8 1067 (define x 7) 1068 x)) 1069(test 8 'define ; used to be 6 1070 (let ([y 8]) 1071 (define (define z w) 5) 1072 (define y 6) 1073 y)) 1074 1075(syntax-test #'(let () 1076 (define x 5))) 1077(syntax-test #'(let () 1078 (if #t 1079 (define x 5)) 1080 5)) 1081 1082; Can shadow syntax/macros with embedded defines 1083(test 5 'intdef (let () 1084 (define lambda 5) 1085 lambda)) 1086(test 5 'intdef (let () 1087 (define define 5) 1088 'ok 1089 define)) 1090 1091(syntax-test #'(lambda () (define x 10) (begin))) 1092(syntax-test #'(lambda () (define x 10) (begin) (begin))) 1093(syntax-test #'(lambda () (#%stratified-syntax (define x 10) (begin) (begin x) (begin)))) 1094(syntax-test #'(lambda () (#%stratified-syntax (define x 10) x (define y 12) y))) 1095(syntax-test #'(lambda () (define-values (x) . 10) x)) 1096(syntax-test #'(lambda () (define-values (x) 10) (begin 1 . 2) x)) 1097(syntax-test #'(lambda () (begin (define-values (x) 10) . 2) x)) 1098(syntax-test #'(lambda () (begin))) 1099(syntax-test #'(lambda () (define-values . 10) x)) 1100(syntax-test #'(lambda () (define-values x 10) x)) 1101(syntax-test #'(lambda () (define-values (1) 10) x)) 1102 1103(test '(10 12) apply (lambda () (define x 10) (random 3) (define y 12) (list x y)) null) 1104(test 10 apply (lambda () (define x 10) (begin) (begin x) (begin)) null) 1105 1106(test '(11 18) apply (lambda () (define x 11) (values 1 2 3) (define y 18) (list x y)) null) 1107 1108(test 87 (lambda () (define x 87) (begin) (begin x))) 1109 1110(test '#(0 1 2 3 4) 'do (do ((vec (make-vector 5)) 1111 (i 0 (+ i 1))) 1112 ((= i 5) vec) 1113 (vector-set! vec i i))) 1114(test 25 'do (let ((x '(1 3 5 7 9))) 1115 (do ((x x (cdr x)) 1116 (sum 0 (+ sum (car x)))) 1117 ((null? x) sum)))) 1118(test 1 'let (let foo () 1)) 1119(test '((6 1 3) (-5 -2)) 'let 1120 (let loop ((numbers '(3 -2 1 6 -5)) 1121 (nonneg '()) 1122 (neg '())) 1123 (cond ((null? numbers) (list nonneg neg)) 1124 ((negative? (car numbers)) 1125 (loop (cdr numbers) 1126 nonneg 1127 (cons (car numbers) neg))) 1128 (else 1129 (loop (cdr numbers) 1130 (cons (car numbers) nonneg) 1131 neg))))) 1132(test 5 'do (do ((x 1)) (#t 5))) 1133(test-values '(10 5) (lambda () (do ((x 1)) (#t (values 10 5))))) 1134(syntax-test #'do) 1135(syntax-test #'(do)) 1136(syntax-test #'(do ()) ) 1137(syntax-test #'(do () ()) ) 1138(syntax-test #'(do (1) (#t 5) 5)) 1139(syntax-test #'(do ((1)) (#t 5) 5)) 1140(syntax-test #'(do ((1 7)) (#t 5) 5)) 1141(syntax-test #'(do ((x . 1)) (#t 5) 5)) 1142(syntax-test #'(do ((x 1) 2) (#t 5) 5)) 1143(syntax-test #'(do ((x 1) . 2) (#t 5) 5)) 1144(syntax-test #'(do ((x 1)) (#t . 5) 5)) 1145(syntax-test #'(do ((x 1)) (#t 5) . 5)) 1146 1147(test 0 'let/cc (let/cc k (k 0) 1)) 1148(test 0 'let/cc (let/cc k 0)) 1149(test 1 'let/cc (let/cc k (cons 1 2) 1)) 1150(test-values '(2 1) (lambda () (let/cc k (values 2 1)))) 1151(test-values '(2 1) (lambda () (let/cc k (k 2 1)))) 1152(syntax-test #'(let/cc)) 1153(syntax-test #'(let/cc . k)) 1154(syntax-test #'(let/cc k)) 1155(syntax-test #'(let/cc k . 1)) 1156(syntax-test #'(let/cc 1 1)) 1157 1158(test 0 'let/ec (let/ec k (k 0) 1)) 1159(test 0 'let/ec (let/ec k 0)) 1160(test 1 'let/ec (let/ec k (cons 1 2) 1)) 1161(test-values '(2 1) (lambda () (let/ec k (values 2 1)))) 1162(test-values '(2 1) (lambda () (let/ec k (k 2 1)))) 1163(syntax-test #'(let/ec)) 1164(syntax-test #'(let/ec . k)) 1165(syntax-test #'(let/ec k)) 1166(syntax-test #'(let/ec k . 1)) 1167(syntax-test #'(let/ec 1 1)) 1168 1169(define x 1) 1170(define y -1) 1171(define (get-x) x) 1172 1173(test 5 'parameterize (parameterize () 5)) 1174(test 6 'parameterize (parameterize ([error-print-width 10]) 6)) 1175(test 7 'parameterize (parameterize ([error-print-width 10] 1176 [uncaught-exception-handler void]) 1177 7)) 1178(define oepw (error-print-width)) 1179(error-test #'(parameterize ([error-print-width 777]) (error 'bad)) exn:fail?) 1180(test oepw 'parameterize (error-print-width)) 1181(error-test #'(parameterize ([error-print-width 777] 1182 [current-output-port (current-error-port)]) 1183 (error 'bad)) 1184 exn:fail?) 1185(error-test #'(parameterize ([error-print-width 'a]) 10)) 1186 1187(define p (make-parameter 1)) 1188(define q (make-parameter 2)) 1189(test '1 'pz-order (parameterize ([p 3][q (p)]) (q))) 1190 1191(error-test #'(parameterize) syntaxe?) 1192(error-test #'(parameterize ()) syntaxe?) 1193(error-test #'(parameterize ((x y))) syntaxe?) 1194(error-test #'(parameterize ((x y)) . 8) syntaxe?) 1195(error-test #'(parameterize (x) 8) syntaxe?) 1196(error-test #'(parameterize (9) 8) syntaxe?) 1197(error-test #'(parameterize ((x z) . y) 8) syntaxe?) 1198(error-test #'(parameterize ((x . z)) 8) syntaxe?) 1199(error-test #'(parameterize ((x . 9)) 8) syntaxe?) 1200(error-test #'(parameterize ((x . 9)) 8) syntaxe?) 1201 1202(error-test #'(parameterize ([10 10]) 8)) 1203(error-test #'(parameterize ([10 10]) 8) (lambda (exn) (not (regexp-match #rx"argument" (exn-message exn))))) 1204(error-test #'(parameterize ([(lambda () 10) 10]) 8)) 1205(error-test #'(parameterize ([(lambda (a) 10) 10]) 8)) 1206(error-test #'(parameterize ([(lambda (a b) 10) 10]) 8)) 1207 1208(test 1 'time (time 1)) 1209(test -1 'time (time (cons 1 2) -1)) 1210(test-values '(-1 1) (lambda () (time (values -1 1)))) 1211(syntax-test #'time) 1212(syntax-test #'(time)) 1213(syntax-test #'(time . 1)) 1214(syntax-test #'(time 1 . 2)) 1215 1216; Tests specifically aimed at the compiler 1217(error-test #'(let ([x (values 1 2)]) x) exn:application:arity?) 1218; Known primitive 1219(error-test #'(let ([x (make-pipe)]) x) exn:application:arity?) 1220; Known local 1221(error-test #'(let* ([f (lambda () (values 1 2))][x (f)]) x) exn:application:arity?) 1222 1223; Known local with global in its closure 1224(test 15 'known (let ([g (lambda () 1225 (letrec ([f (lambda (x) 1226 (+ x 5))]) 1227 (f 10)))]) 1228 (g))) 1229; Known local with a set! 1230(test 16 'known (let ([g (lambda () 1231 (letrec ([f (lambda (x) 1232 (let ([y x]) 1233 (set! x 7) 1234 (+ y 5)))]) 1235 (f 11)))]) 1236 (g))) 1237; Known local non-function 1238(error-test #'(apply (lambda () (let ([f 12]) (f))) null) exn:application:type?) 1239; Known local with revsed arguments: 1240(test 10 (letrec ([f (lambda (a b) (if (zero? a) b (f b a)))]) f) 10 0) 1241 1242(syntax-test #'#%datum) 1243(syntax-test #'(let ([#%datum 5]) 1244 1)) 1245(test '(1) '#%datum (#%datum 1)) 1246(test 1 '#%datum (#%datum . 1)) 1247(test 'a '#%datum (#%datum . a)) 1248 1249(syntax-test #'#%app) 1250(syntax-test #'(#%app . 1)) 1251(syntax-test #'(#%app 2 . 1)) 1252(syntax-test #'(#%app lambda 1)) 1253(syntax-test #'(let ([#%app 5]) 1254 (+ 1 2))) 1255 1256(test 3 '#%app (#%app + 1 2)) 1257(syntax-test #'()) 1258(syntax-test #'(#%app)) 1259 1260(syntax-test #'#%top) 1261(syntax-test #'(#%top 1)) 1262(syntax-test #'(let ([#%top 5]) 1263 x)) 1264(err/rt-test (#%top . lambda) exn:fail:contract:variable?) 1265(define x 5) 1266(test 5 '#%top (#%top . x)) 1267 1268;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1269;; Tests related to bytecode optimizer. 1270;; The (if (let ([x M]) (if x x N)) ...) 1271;; => (if (if M #t N) ...) 1272;; converter drops the variable `x', which means 1273;; that other mappings must adjust 1274 1275(let ([val 0]) 1276 (let ([g (lambda () 1277 (letrec ([f (lambda (z x) 1278 (if (let ([w (even? 81)]) 1279 (if w 1280 w 1281 (let ([y x]) 1282 (set! x 7) 1283 (set! val (+ y 5))))) 1284 'yes 1285 'no))]) 1286 (f 0 11)))]) 1287 (g)) 1288 (test 16 values val)) 1289 1290(let ([val 0]) 1291 (let ([g (lambda () 1292 (letrec ([f (lambda (z x) 1293 (if (let ([w (even? 81)]) 1294 (if w 1295 w 1296 (let ([y x]) 1297 (set! val (+ y 5))))) 1298 'yes 1299 'no))]) 1300 (f 0 11)))]) 1301 (g)) 1302 (test 16 values val)) 1303 1304;; Function-inline test where (h (g v 10)) involves two inlines: 1305(letrec ([f (lambda (x) (h (g v 10)))] 1306 [h (lambda (x) (list x x))] 1307 [g (lambda (a b) a)] 1308 [v (list 'hello)] 1309 [w (list 'no!)]) 1310 (test '((hello) (hello)) f 10)) 1311 1312;; Inlining introduces a let binding that is immediately dropped: 1313(test '(1 . 2) 1314 (let ([x (cons 1 2)]) (let ([f (lambda (x) x)]) (f (lambda (y) x)))) 1315 10) 1316 1317;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1318;; Check #%top-interaction 1319 1320(module quoting-top-interaction racket/base 1321 (require (for-syntax racket/base)) 1322 (provide (except-out (all-from-out racket/base) #%top-interaction) 1323 (rename-out [top-interaction #%top-interaction])) 1324 (define-syntax top-interaction 1325 (syntax-rules () 1326 [(_ . e) (quote e)]))) 1327 1328(dynamic-require ''quoting-top-interaction #f) 1329(let ([ns (make-empty-namespace)]) 1330 (namespace-attach-module (current-namespace) ''quoting-top-interaction ns) 1331 (parameterize ([current-namespace ns]) 1332 (namespace-require ''quoting-top-interaction)) 1333 (test 3 'non-top 1334 (parameterize ([current-namespace ns]) 1335 (eval '(+ 1 2)))) 1336 (test ''(+ 1 2) 'repl-top 1337 (let ([s (open-output-bytes)]) 1338 (parameterize ([current-input-port (open-input-string "(+ 1 2)")] 1339 [current-namespace ns] 1340 [current-output-port s]) 1341 (read-eval-print-loop)) 1342 (let ([p (open-input-bytes (get-output-bytes s))]) 1343 (read p) 1344 (read p)))) 1345 (let ([tmp-file (make-temporary-file)]) 1346 (let-values ([(base tmp1 mbd?) (split-path tmp-file)]) 1347 (with-output-to-file tmp-file (lambda () (display '(+ 1 2))) #:exists 'truncate/replace) 1348 (test '(+ 1 2) 'repl-top 1349 (parameterize ([current-namespace ns]) 1350 (load tmp-file))) 1351 (with-output-to-file tmp-file (lambda () (display `(module ,tmp1 racket/base (provide x) (define x 12)))) 1352 #:exists 'truncate/replace) 1353 (test 12 'module 1354 (parameterize ([current-namespace ns]) 1355 (dynamic-require tmp-file 'x))) 1356 (delete-file tmp-file)))) 1357 1358;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1359 1360;; Check that locations for lambda arguments are created 1361;; one-by-one --- like `let*', and not like `letrec': 1362 1363(test '((1 10) (x1 10) (x2 z1)) 1364 'lambda-loc 1365 (let () 1366 (define procs null) 1367 (define again #f) 1368 1369 (define (f x 1370 [y (let/cc k 1371 (unless again 1372 (set! again k)) 1373 (lambda () 'done))] 1374 [z 10]) 1375 (set! procs 1376 (cons (lambda (xv zv) 1377 (begin0 1378 (list x z) 1379 (set! x xv) 1380 (set! z zv))) 1381 procs)) 1382 (y)) 1383 1384 (f 1) 1385 (let/cc esc (again esc)) 1386 1387 (list 1388 ((cadr procs) 'x1 'z1) 1389 ((car procs) 'x2 'z2) 1390 ((cadr procs) 'x10 'z10)))) 1391 1392;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1393(require racket/splicing) 1394 1395(define abcdefg 10) 1396(test 12 'splicing-letrec-syntax (splicing-letrec-syntax ([abcdefg (syntax-rules () 1397 [(_) 12])]) 1398 (abcdefg))) 1399(test 13 'splicing-letrec-syntax (splicing-letrec-syntax ([abcdefg (syntax-rules () 1400 [(_) (abcdefg 10)] 1401 [(_ x) (+ 3 x)])]) 1402 (abcdefg))) 1403(test 13 'splicing-letrec-syntax (let ([abcdefg 9]) 1404 (splicing-letrec-syntax ([abcdefg (syntax-rules () 1405 [(_) (abcdefg 10)] 1406 [(_ x) (+ 3 x)])]) 1407 (abcdefg)))) 1408(test 12 'splicing-let-syntax (splicing-let-syntax ([abcdefg (syntax-rules () 1409 [(_) 12])]) 1410 (abcdefg))) 1411(test 12 'splicing-let-syntax (let ([abcdefg (lambda () 9)]) 1412 (splicing-let-syntax ([abcdefg (syntax-rules () 1413 [(_) 12])]) 1414 (abcdefg)))) 1415(test 11 'splicing-let-syntax (let ([abcdefg (lambda (x) x)]) 1416 (splicing-let-syntax ([abcdefg (syntax-rules () 1417 [(_) (+ 2 (abcdefg 9))] 1418 [(_ ?) 77])]) 1419 (abcdefg)))) 1420(define expand-test-use-toplevel? #t) 1421(splicing-let-syntax ([abcdefg (syntax-rules () 1422 [(_) 8])]) 1423 (define hijklmn (abcdefg))) 1424(define expand-test-use-toplevel? #f) 1425(test 8 'hijklmn hijklmn) 1426(test 30 'local-hijklmn (let () 1427 (splicing-let-syntax ([abcdefg (syntax-rules () 1428 [(_) 8])]) 1429 (define hijklmn (abcdefg))) 1430 (define other 22) 1431 (+ other hijklmn))) 1432(test 8 'local-hijklmn (let () 1433 (splicing-let-syntax ([abcdefg (syntax-rules () 1434 [(_) 8])]) 1435 (begin 1436 (define hijklmn (abcdefg)) 1437 hijklmn)))) 1438 1439(test 9 'splicing-letrec-syntax (let ([abcdefg (lambda () 9)]) 1440 (splicing-letrec-syntax ([abcdefg (syntax-rules () 1441 …
Large files files are truncated, but you can click here to view the full file