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