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