test-suite/tests/syntax.test

   1 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2001, 2003 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation; either version 2, or (at your option)
   8 ;;;; any later version.
   9 ;;;;
  10 ;;;; This program is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18 ;;;; Boston, MA 02111-1307 USA
  19
  20 (define-module (test-suite test-syntax)
  21   :use-module (test-suite lib))
  22
  23
  24 (define exception:bad-expression
  25   (cons 'syntax-error "Bad expression"))
  26 (define exception:bad-bindings
  27   (cons 'misc-error "^bad bindings"))
  28 (define exception:duplicate-bindings
  29   (cons 'misc-error "^duplicate bindings"))
  30 (define exception:bad-body
  31   (cons 'misc-error "^bad body"))
  32 (define exception:bad-formals
  33   (cons 'misc-error "^bad formals"))
  34 (define exception:duplicate-formals
  35   (cons 'misc-error "^duplicate formals"))
  36 (define exception:missing-clauses
  37   (cons 'syntax-error "Missing clauses"))
  38 (define exception:bad-var
  39   (cons 'misc-error "^bad variable"))
  40 (define exception:bad/missing-clauses
  41   (cons 'misc-error "^bad or missing clauses"))
  42 (define exception:bad-case-clause
  43   (cons 'syntax-error "Bad case clause"))
  44 (define exception:extra-case-clause
  45   (cons 'syntax-error "Extra case clause"))
  46 (define exception:bad-case-labels
  47   (cons 'syntax-error "Bad case labels"))
  48 (define exception:missing/extra-expr
  49   (cons 'misc-error "^missing or extra expression"))
  50
  51
  52 (with-test-prefix "expressions"
  53
  54   (with-test-prefix "Bad argument list"
  55
  56     (pass-if-exception "improper argument list of length 1"
  57       exception:wrong-num-args
  58       (eval '(let ((foo (lambda (x y) #t)))
  59                (foo . 1))
  60             (interaction-environment)))
  61
  62     (pass-if-exception "improper argument list of length 2"
  63       exception:wrong-num-args
  64       (eval '(let ((foo (lambda (x y) #t)))
  65                (foo 1 . 2))
  66             (interaction-environment))))
  67
  68   (with-test-prefix "missing or extra expression"
  69
  70     ;; R5RS says:
  71     ;; *Note:* In many dialects of Lisp, the empty combination, (),
  72     ;; is a legitimate expression.  In Scheme, combinations must
  73     ;; have at least one subexpression, so () is not a syntactically
  74     ;; valid expression.
  75
  76     ;; Fixed on 2001-3-3
  77     (pass-if-exception "empty parentheses \"()\""
  78       exception:missing/extra-expr
  79       (eval '()
  80             (interaction-environment)))))
  81
  82 (with-test-prefix "quote"
  83   #t)
  84
  85 (with-test-prefix "quasiquote"
  86
  87   (with-test-prefix "unquote"
  88
  89     (pass-if "repeated execution"
  90       (let ((foo (let ((i 0)) (lambda () (set! i (+ i 1)) `(,i)))))
  91         (and (equal? (foo) '(1)) (equal? (foo) '(2))))))
  92
  93   (with-test-prefix "unquote-splicing"
  94
  95     (pass-if-exception "extra arguments"
  96       exception:missing/extra-expr
  97       (quasiquote ((unquote-splicing (list 1 2) (list 3 4)))))))
  98
  99 (with-test-prefix "begin"
 100
 101   (pass-if "legal (begin)"
 102     (begin)
 103     #t)
 104
 105   (expect-fail-exception "illegal (begin)"
 106     exception:bad-body
 107     (if #t (begin))
 108     #t))
 109
 110 (with-test-prefix "lambda"
 111
 112   (with-test-prefix "bad formals"
 113
 114     (pass-if-exception "(lambda)"
 115       exception:bad-formals
 116       (eval '(lambda)
 117             (interaction-environment)))
 118
 119     (pass-if-exception "(lambda . \"foo\")"
 120       exception:bad-formals
 121       (eval '(lambda . "foo")
 122             (interaction-environment)))
 123
 124     (pass-if-exception "(lambda \"foo\")"
 125       exception:bad-formals
 126       (eval '(lambda "foo")
 127             (interaction-environment)))
 128
 129     (pass-if-exception "(lambda \"foo\" #f)"
 130       exception:bad-formals
 131       (eval '(lambda "foo" #f)
 132             (interaction-environment)))
 133
 134     (pass-if-exception "(lambda (x 1) 2)"
 135       exception:bad-formals
 136       (eval '(lambda (x 1) 2)
 137             (interaction-environment)))
 138
 139     (pass-if-exception "(lambda (1 x) 2)"
 140       exception:bad-formals
 141       (eval '(lambda (1 x) 2)
 142             (interaction-environment)))
 143
 144     (pass-if-exception "(lambda (x \"a\") 2)"
 145       exception:bad-formals
 146       (eval '(lambda (x "a") 2)
 147             (interaction-environment)))
 148
 149     (pass-if-exception "(lambda (\"a\" x) 2)"
 150       exception:bad-formals
 151       (eval '(lambda ("a" x) 2)
 152             (interaction-environment))))
 153
 154   (with-test-prefix "duplicate formals"
 155
 156     ;; Fixed on 2001-3-3
 157     (pass-if-exception "(lambda (x x) 1)"
 158       exception:duplicate-formals
 159       (eval '(lambda (x x) 1)
 160             (interaction-environment)))
 161
 162     ;; Fixed on 2001-3-3
 163     (pass-if-exception "(lambda (x x x) 1)"
 164       exception:duplicate-formals
 165       (eval '(lambda (x x x) 1)
 166             (interaction-environment))))
 167
 168   (with-test-prefix "bad body"
 169
 170     (pass-if-exception "(lambda ())"
 171       exception:bad-body
 172       (eval '(lambda ())
 173             (interaction-environment)))))
 174
 175 (with-test-prefix "let"
 176
 177   (with-test-prefix "bindings"
 178
 179     (pass-if-exception "late binding"
 180       exception:unbound-var
 181       (let ((x 1) (y x)) y)))
 182
 183   (with-test-prefix "bad bindings"
 184
 185     (pass-if-exception "(let)"
 186       exception:bad-bindings
 187       (eval '(let)
 188             (interaction-environment)))
 189
 190     (pass-if-exception "(let 1)"
 191       exception:bad-bindings
 192       (eval '(let 1)
 193             (interaction-environment)))
 194
 195     (pass-if-exception "(let (x))"
 196       exception:bad-bindings
 197       (eval '(let (x))
 198             (interaction-environment)))
 199
 200     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 201     ;; (Even although the body is bad as well...)
 202     (pass-if-exception "(let ((x)))"
 203       exception:bad-body
 204       (eval '(let ((x)))
 205             (interaction-environment)))
 206
 207     (pass-if-exception "(let (x) 1)"
 208       exception:bad-bindings
 209       (eval '(let (x) 1)
 210             (interaction-environment)))
 211
 212     (pass-if-exception "(let ((x)) 3)"
 213       exception:bad-bindings
 214       (eval '(let ((x)) 3)
 215             (interaction-environment)))
 216
 217     (pass-if-exception "(let ((x 1) y) x)"
 218       exception:bad-bindings
 219       (eval '(let ((x 1) y) x)
 220             (interaction-environment)))
 221
 222     (pass-if-exception "(let ((1 2)) 3)"
 223       exception:bad-var
 224       (eval '(let ((1 2)) 3)
 225             (interaction-environment))))
 226
 227   (with-test-prefix "duplicate bindings"
 228
 229     (pass-if-exception "(let ((x 1) (x 2)) x)"
 230       exception:duplicate-bindings
 231       (eval '(let ((x 1) (x 2)) x)
 232             (interaction-environment))))
 233
 234   (with-test-prefix "bad body"
 235
 236     (pass-if-exception "(let ())"
 237       exception:bad-body
 238       (eval '(let ())
 239             (interaction-environment)))
 240
 241     (pass-if-exception "(let ((x 1)))"
 242       exception:bad-body
 243       (eval '(let ((x 1)))
 244             (interaction-environment)))))
 245
 246 (with-test-prefix "named let"
 247
 248   (with-test-prefix "initializers"
 249
 250     (pass-if "evaluated in outer environment"
 251       (let ((f -))
 252         (eqv? (let f ((n (f 1))) n) -1))))
 253
 254   (with-test-prefix "bad bindings"
 255
 256     (pass-if-exception "(let x (y))"
 257       exception:bad-bindings
 258       (eval '(let x (y))
 259             (interaction-environment))))
 260
 261   (with-test-prefix "bad body"
 262
 263     (pass-if-exception "(let x ())"
 264       exception:bad-body
 265       (eval '(let x ())
 266             (interaction-environment)))
 267
 268     (pass-if-exception "(let x ((y 1)))"
 269       exception:bad-body
 270       (eval '(let x ((y 1)))
 271             (interaction-environment)))))
 272
 273 (with-test-prefix "let*"
 274
 275   (with-test-prefix "bindings"
 276
 277     (pass-if "(let* ((x 1) (x 2)) ...)"
 278       (let* ((x 1) (x 2))
 279         (= x 2)))
 280
 281     (pass-if "(let* ((x 1) (x x)) ...)"
 282       (let* ((x 1) (x x))
 283         (= x 1))))
 284
 285   (with-test-prefix "bad bindings"
 286
 287     (pass-if-exception "(let*)"
 288       exception:bad-bindings
 289       (eval '(let*)
 290             (interaction-environment)))
 291
 292     (pass-if-exception "(let* 1)"
 293       exception:bad-bindings
 294       (eval '(let* 1)
 295             (interaction-environment)))
 296
 297     (pass-if-exception "(let* (x))"
 298       exception:bad-bindings
 299       (eval '(let* (x))
 300             (interaction-environment)))
 301
 302     (pass-if-exception "(let* (x) 1)"
 303       exception:bad-bindings
 304       (eval '(let* (x) 1)
 305             (interaction-environment)))
 306
 307     (pass-if-exception "(let* ((x)) 3)"
 308       exception:bad-bindings
 309       (eval '(let* ((x)) 3)
 310             (interaction-environment)))
 311
 312     (pass-if-exception "(let* ((x 1) y) x)"
 313       exception:bad-bindings
 314       (eval '(let* ((x 1) y) x)
 315             (interaction-environment)))
 316
 317     (pass-if-exception "(let* x ())"
 318       exception:bad-bindings
 319       (eval '(let* x ())
 320             (interaction-environment)))
 321
 322     (pass-if-exception "(let* x (y))"
 323       exception:bad-bindings
 324       (eval '(let* x (y))
 325             (interaction-environment)))
 326
 327     (pass-if-exception "(let* ((1 2)) 3)"
 328       exception:bad-var
 329       (eval '(let* ((1 2)) 3)
 330             (interaction-environment))))
 331
 332   (with-test-prefix "bad body"
 333
 334     (pass-if-exception "(let* ())"
 335       exception:bad-body
 336       (eval '(let* ())
 337             (interaction-environment)))
 338
 339     (pass-if-exception "(let* ((x 1)))"
 340       exception:bad-body
 341       (eval '(let* ((x 1)))
 342             (interaction-environment)))))
 343
 344 (with-test-prefix "letrec"
 345
 346   (with-test-prefix "bindings"
 347
 348     (pass-if-exception "initial bindings are undefined"
 349       exception:unbound-var
 350       (let ((x 1))
 351         (letrec ((x 1) (y x)) y))))
 352
 353   (with-test-prefix "bad bindings"
 354
 355     (pass-if-exception "(letrec)"
 356       exception:bad-bindings
 357       (eval '(letrec)
 358             (interaction-environment)))
 359
 360     (pass-if-exception "(letrec 1)"
 361       exception:bad-bindings
 362       (eval '(letrec 1)
 363             (interaction-environment)))
 364
 365     (pass-if-exception "(letrec (x))"
 366       exception:bad-bindings
 367       (eval '(letrec (x))
 368             (interaction-environment)))
 369
 370     (pass-if-exception "(letrec (x) 1)"
 371       exception:bad-bindings
 372       (eval '(letrec (x) 1)
 373             (interaction-environment)))
 374
 375     (pass-if-exception "(letrec ((x)) 3)"
 376       exception:bad-bindings
 377       (eval '(letrec ((x)) 3)
 378             (interaction-environment)))
 379
 380     (pass-if-exception "(letrec ((x 1) y) x)"
 381       exception:bad-bindings
 382       (eval '(letrec ((x 1) y) x)
 383             (interaction-environment)))
 384
 385     (pass-if-exception "(letrec x ())"
 386       exception:bad-bindings
 387       (eval '(letrec x ())
 388             (interaction-environment)))
 389
 390     (pass-if-exception "(letrec x (y))"
 391       exception:bad-bindings
 392       (eval '(letrec x (y))
 393             (interaction-environment)))
 394
 395     (pass-if-exception "(letrec ((1 2)) 3)"
 396       exception:bad-var
 397       (eval '(letrec ((1 2)) 3)
 398             (interaction-environment))))
 399
 400   (with-test-prefix "duplicate bindings"
 401
 402     (pass-if-exception "(letrec ((x 1) (x 2)) x)"
 403       exception:duplicate-bindings
 404       (eval '(letrec ((x 1) (x 2)) x)
 405             (interaction-environment))))
 406
 407   (with-test-prefix "bad body"
 408
 409     (pass-if-exception "(letrec ())"
 410       exception:bad-body
 411       (eval '(letrec ())
 412             (interaction-environment)))
 413
 414     (pass-if-exception "(letrec ((x 1)))"
 415       exception:bad-body
 416       (eval '(letrec ((x 1)))
 417             (interaction-environment)))))
 418
 419 (with-test-prefix "if"
 420
 421   (with-test-prefix "missing or extra expressions"
 422
 423     (pass-if-exception "(if)"
 424       exception:missing/extra-expr
 425       (eval '(if)
 426             (interaction-environment)))
 427
 428     (pass-if-exception "(if 1 2 3 4)"
 429       exception:missing/extra-expr
 430       (eval '(if 1 2 3 4)
 431             (interaction-environment)))))
 432
 433 (with-test-prefix "cond"
 434
 435   (with-test-prefix "bad or missing clauses"
 436
 437     (pass-if-exception "(cond)"
 438       exception:bad/missing-clauses
 439       (eval '(cond)
 440             (interaction-environment)))
 441
 442     (pass-if-exception "(cond #t)"
 443       exception:bad/missing-clauses
 444       (eval '(cond #t)
 445             (interaction-environment)))
 446
 447     (pass-if-exception "(cond 1)"
 448       exception:bad/missing-clauses
 449       (eval '(cond 1)
 450             (interaction-environment)))
 451
 452     (pass-if-exception "(cond 1 2)"
 453       exception:bad/missing-clauses
 454       (eval '(cond 1 2)
 455             (interaction-environment)))
 456
 457     (pass-if-exception "(cond 1 2 3)"
 458       exception:bad/missing-clauses
 459       (eval '(cond 1 2 3)
 460             (interaction-environment)))
 461
 462     (pass-if-exception "(cond 1 2 3 4)"
 463       exception:bad/missing-clauses
 464       (eval '(cond 1 2 3 4)
 465             (interaction-environment)))
 466
 467     (pass-if-exception "(cond ())"
 468       exception:bad/missing-clauses
 469       (eval '(cond ())
 470             (interaction-environment)))
 471
 472     (pass-if-exception "(cond () 1)"
 473       exception:bad/missing-clauses
 474       (eval '(cond () 1)
 475             (interaction-environment)))
 476
 477     (pass-if-exception "(cond (1) 1)"
 478       exception:bad/missing-clauses
 479       (eval '(cond (1) 1)
 480             (interaction-environment)))))
 481
 482 (with-test-prefix "cond =>"
 483
 484   (with-test-prefix "cond is hygienic"
 485
 486     (expect-fail "bound 'else is handled correctly"
 487       (false-if-exception
 488        (eq? (let ((else 'ok)) (cond (else))) 'ok)))
 489
 490     (expect-fail "bound '=> is handled correctly"
 491       (false-if-exception
 492        (eq? (let ((=> #f)) (cond (#t => 'ok))) 'ok))))
 493
 494   (with-test-prefix "else is handled correctly"
 495
 496     (pass-if "else =>"
 497       (let ((=> 'foo))
 498         (eq? (cond (else =>)) 'foo)))
 499
 500     (pass-if "else => identity"
 501       (let* ((=> 'foo))
 502         (eq? (cond (else => identity)) identity))))
 503
 504   (with-test-prefix "wrong number of arguments"
 505
 506     (pass-if-exception "=> (lambda (x y) #t)"
 507       exception:wrong-num-args
 508       (cond (1 => (lambda (x y) #t))))))
 509
 510 (with-test-prefix "case"
 511
 512   (pass-if "clause with empty labels list"
 513     (case 1 (() #f) (else #t)))
 514
 515   (with-test-prefix "case is hygienic"
 516
 517     (pass-if-exception "bound 'else is handled correctly"
 518       exception:bad-case-labels
 519       (eval '(let ((else #f)) (case 1 (else #f)))
 520             (interaction-environment))))
 521
 522   (with-test-prefix "bad or missing clauses"
 523
 524     (pass-if-exception "(case)"
 525       exception:missing-clauses
 526       (eval '(case)
 527             (interaction-environment)))
 528
 529     (pass-if-exception "(case . \"foo\")"
 530       exception:bad-expression
 531       (eval '(case . "foo")
 532             (interaction-environment)))
 533
 534     (pass-if-exception "(case 1)"
 535       exception:missing-clauses
 536       (eval '(case 1)
 537             (interaction-environment)))
 538
 539     (pass-if-exception "(case 1 . \"foo\")"
 540       exception:bad-expression
 541       (eval '(case 1 . "foo")
 542             (interaction-environment)))
 543
 544     (pass-if-exception "(case 1 \"foo\")"
 545       exception:bad-case-clause
 546       (eval '(case 1 "foo")
 547             (interaction-environment)))
 548
 549     (pass-if-exception "(case 1 ())"
 550       exception:bad-case-clause
 551       (eval '(case 1 ())
 552             (interaction-environment)))
 553
 554     (pass-if-exception "(case 1 (\"foo\"))"
 555       exception:bad-case-clause
 556       (eval '(case 1 ("foo"))
 557             (interaction-environment)))
 558
 559     (pass-if-exception "(case 1 (\"foo\" \"bar\"))"
 560       exception:bad-case-labels
 561       (eval '(case 1 ("foo" "bar"))
 562             (interaction-environment)))
 563
 564     (pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
 565       exception:bad-expression
 566       (eval '(case 1 ((2) "bar") . "foo")
 567             (interaction-environment)))
 568
 569     (pass-if-exception "(case 1 ((2) \"bar\") (else))"
 570       exception:bad-case-clause
 571       (eval '(case 1 ((2) "bar") (else))
 572             (interaction-environment)))
 573
 574     (pass-if-exception "(case 1 (else #f) . \"foo\")"
 575       exception:bad-expression
 576       (eval '(case 1 (else #f) . "foo")
 577             (interaction-environment)))
 578
 579     (pass-if-exception "(case 1 (else #f) ((1) #t))"
 580       exception:extra-case-clause
 581       (eval '(case 1 (else #f) ((1) #t))
 582             (interaction-environment)))))
 583
 584 (with-test-prefix "define"
 585
 586   (with-test-prefix "currying"
 587
 588     (pass-if "(define ((foo)) #f)"
 589       (define ((foo)) #t)
 590       ((foo))))
 591
 592   (with-test-prefix "missing or extra expressions"
 593
 594     (pass-if-exception "(define)"
 595       exception:missing/extra-expr
 596       (eval '(define)
 597             (interaction-environment)))))
 598
 599 (with-test-prefix "set!"
 600
 601   (with-test-prefix "missing or extra expressions"
 602
 603     (pass-if-exception "(set!)"
 604       exception:missing/extra-expr
 605       (eval '(set!)
 606             (interaction-environment)))
 607
 608     (pass-if-exception "(set! 1)"
 609       exception:missing/extra-expr
 610       (eval '(set! 1)
 611             (interaction-environment)))
 612
 613     (pass-if-exception "(set! 1 2 3)"
 614       exception:missing/extra-expr
 615       (eval '(set! 1 2 3)
 616             (interaction-environment))))
 617
 618   (with-test-prefix "bad variable"
 619
 620     (pass-if-exception "(set! \"\" #t)"
 621       exception:bad-var
 622       (eval '(set! "" #t)
 623             (interaction-environment)))
 624
 625     (pass-if-exception "(set! 1 #t)"
 626       exception:bad-var
 627       (eval '(set! 1 #t)
 628             (interaction-environment)))
 629
 630     (pass-if-exception "(set! #t #f)"
 631       exception:bad-var
 632       (eval '(set! #t #f)
 633             (interaction-environment)))
 634
 635     (pass-if-exception "(set! #f #t)"
 636       exception:bad-var
 637       (eval '(set! #f #t)
 638             (interaction-environment)))
 639
 640     (pass-if-exception "(set! #\space #f)"
 641       exception:bad-var
 642       (eval '(set! #\space #f)
 643             (interaction-environment)))))
 644
 645 (with-test-prefix "quote"
 646
 647   (with-test-prefix "missing or extra expression"
 648
 649     (pass-if-exception "(quote)"
 650       exception:missing/extra-expr
 651       (eval '(quote)
 652             (interaction-environment)))
 653
 654     (pass-if-exception "(quote a b)"
 655       exception:missing/extra-expr
 656       (eval '(quote a b)
 657             (interaction-environment)))))
 658
 659 (with-test-prefix "while"
 660
 661   (define (unreachable)
 662     (error "unreachable code has been reached!"))
 663
 664   ;; Return a new procedure COND which when called (COND) will return #t the
 665   ;; first N times, then #f, then any further call is an error.  N=0 is
 666   ;; allowed, in which case #f is returned by the first call.
 667   (define (make-iterations-cond n)
 668     (lambda ()
 669       (cond ((not n)
 670              (error "oops, condition re-tested after giving false"))
 671             ((= 0 n)
 672              (set! n #f)
 673              #f)
 674             (else
 675              (set! n (1- n))
 676              #t))))
 677
 678
 679   (pass-if-exception "too few args" exception:wrong-num-args
 680     (eval '(while) (interaction-environment)))
 681
 682   (with-test-prefix "empty body"
 683     (do ((n 0 (1+ n)))
 684         ((> n 5))
 685       (pass-if n
 686         (let ((cond (make-iterations-cond n)))
 687           (while (cond)))
 688         #t)))
 689
 690   (pass-if "initially false"
 691     (while #f
 692       (unreachable))
 693     #t)
 694
 695   (with-test-prefix "in empty environment"
 696
 697     ;; an environment with no bindings at all
 698     (define empty-environment
 699       (make-module 1))
 700
 701     (pass-if "empty body"
 702       (eval `(,while #f)
 703             empty-environment)
 704       #t)
 705
 706     (pass-if "initially false"
 707       (eval `(,while #f
 708                #f)
 709             empty-environment)
 710       #t)
 711
 712     (pass-if "iterating"
 713       (let ((cond (make-iterations-cond 3)))
 714         (eval `(,while (,cond)
 715                  123 456)
 716               empty-environment))
 717       #t))
 718
 719   (with-test-prefix "iterations"
 720     (do ((n 0 (1+ n)))
 721         ((> n 5))
 722       (pass-if n
 723         (let ((cond (make-iterations-cond n))
 724               (i    0))
 725           (while (cond)
 726             (set! i (1+ i)))
 727           (= i n)))))
 728
 729   (with-test-prefix "break"
 730
 731     (pass-if-exception "too many args" exception:wrong-num-args
 732       (while #t
 733         (break 1)))
 734
 735     (with-test-prefix "from cond"
 736       (pass-if "first"
 737         (while (begin
 738                  (break)
 739                  (unreachable))
 740           (unreachable))
 741         #t)
 742
 743       (do ((n 0 (1+ n)))
 744           ((> n 5))
 745         (pass-if n
 746           (let ((cond (make-iterations-cond n))
 747                 (i    0))
 748             (while (if (cond)
 749                        #t
 750                        (begin
 751                          (break)
 752                          (unreachable)))
 753               (set! i (1+ i)))
 754             (= i n)))))
 755
 756     (with-test-prefix "from body"
 757       (pass-if "first"
 758         (while #t
 759           (break)
 760           (unreachable))
 761         #t)
 762
 763       (do ((n 0 (1+ n)))
 764           ((> n 5))
 765         (pass-if n
 766           (let ((cond (make-iterations-cond n))
 767                 (i    0))
 768             (while #t
 769               (if (not (cond))
 770                   (begin
 771                     (break)
 772                     (unreachable)))
 773               (set! i (1+ i)))
 774             (= i n)))))
 775
 776     (pass-if "from nested"
 777       (while #t
 778         (let ((outer-break break))
 779           (while #t
 780             (outer-break)
 781             (unreachable)))
 782         (unreachable))
 783       #t)
 784
 785     (pass-if "from recursive"
 786       (let ((outer-break #f))
 787         (define (r n)
 788           (while #t
 789             (if (eq? n 'outer)
 790                 (begin
 791                   (set! outer-break break)
 792                   (r 'inner))
 793                 (begin
 794                   (outer-break)
 795                   (unreachable))))
 796           (if (eq? n 'inner)
 797               (error "broke only from inner loop")))
 798         (r 'outer))
 799       #t))
 800
 801   (with-test-prefix "continue"
 802
 803     (pass-if-exception "too many args" exception:wrong-num-args
 804       (while #t
 805         (continue 1)))
 806
 807     (with-test-prefix "from cond"
 808       (do ((n 0 (1+ n)))
 809           ((> n 5))
 810         (pass-if n
 811           (let ((cond (make-iterations-cond n))
 812                 (i    0))
 813             (while (if (cond)
 814                        (begin
 815                          (set! i (1+ i))
 816                          (continue)
 817                          (unreachable))
 818                        #f)
 819               (unreachable))
 820             (= i n)))))
 821
 822     (with-test-prefix "from body"
 823       (do ((n 0 (1+ n)))
 824           ((> n 5))
 825         (pass-if n
 826           (let ((cond (make-iterations-cond n))
 827                 (i    0))
 828             (while (cond)
 829               (set! i (1+ i))
 830               (continue)
 831               (unreachable))
 832             (= i n)))))
 833
 834     (pass-if "from nested"
 835       (let ((cond (make-iterations-cond 3)))
 836         (while (cond)
 837           (let ((outer-continue continue))
 838             (while #t
 839               (outer-continue)
 840               (unreachable)))))
 841       #t)
 842
 843     (pass-if "from recursive"
 844       (let ((outer-continue #f))
 845         (define (r n)
 846           (let ((cond  (make-iterations-cond 3))
 847                 (first #t))
 848             (while (begin
 849                      (if (and (not first)
 850                               (eq? n 'inner))
 851                          (error "continued only to inner loop"))
 852                      (cond))
 853               (set! first #f)
 854               (if (eq? n 'outer)
 855                   (begin
 856                     (set! outer-continue continue)
 857                     (r 'inner))
 858                   (begin
 859                     (outer-continue)
 860                     (unreachable))))))
 861         (r 'outer))
 862       #t)))