test-suite/tests/syntax.test

   1 ;;;; syntax.test --- test suite for Guile's syntactic forms    -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2001 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
  21 (define exception:bad-bindings
  22   (cons 'misc-error "^bad bindings"))
  23 (define exception:duplicate-bindings
  24   (cons 'misc-error "^duplicate bindings"))
  25 (define exception:bad-body
  26   (cons 'misc-error "^bad body"))
  27 (define exception:bad-formals
  28   (cons 'misc-error "^bad formals"))
  29 (define exception:duplicate-formals
  30   (cons 'misc-error "^duplicate formals"))
  31 (define exception:bad-var
  32   (cons 'misc-error "^bad variable"))
  33 (define exception:bad/missing-clauses
  34   (cons 'misc-error "^bad or missing clauses"))
  35 (define exception:missing/extra-expr
  36   (cons 'misc-error "^missing or extra expression"))
  37
  38
  39 (with-test-prefix "expressions"
  40
  41   (with-test-prefix "missing or extra expression"
  42
  43     ;; R5RS says:
  44     ;; *Note:* In many dialects of Lisp, the empty combination, (),
  45     ;; is a legitimate expression.  In Scheme, combinations must
  46     ;; have at least one subexpression, so () is not a syntactically
  47     ;; valid expression.
  48
  49     ;; Fixed on 2001-3-3
  50     (pass-if-exception "empty parentheses \"()\""
  51       exception:missing/extra-expr
  52       ())))
  53
  54 (with-test-prefix "lambda"
  55
  56   (with-test-prefix "bad formals"
  57
  58     (pass-if-exception "(lambda)"
  59       exception:bad-formals
  60       (lambda))
  61
  62     (pass-if-exception "(lambda . \"foo\")"
  63       exception:bad-formals
  64       (lambda . "foo"))
  65
  66     (pass-if-exception "(lambda ())"
  67       exception:bad-formals
  68       (lambda ()))
  69
  70     (pass-if-exception "(lambda \"foo\")"
  71       exception:bad-formals
  72       (lambda "foo"))
  73
  74     (pass-if-exception "(lambda \"foo\" #f)"
  75       exception:bad-formals
  76       (lambda "foo" #f))
  77
  78     (pass-if-exception "(lambda (x 1) 2)"
  79       exception:bad-formals
  80       (lambda (x 1) 2))
  81
  82     (pass-if-exception "(lambda (1 x) 2)"
  83       exception:bad-formals
  84       (lambda (1 x) 2))
  85
  86     (pass-if-exception "(lambda (x \"a\") 2)"
  87       exception:bad-formals
  88       (lambda (x "a") 2))
  89
  90     (pass-if-exception "(lambda (\"a\" x) 2)"
  91       exception:bad-formals
  92       (lambda ("a" x) 2)))
  93
  94   (with-test-prefix "duplicate formals"
  95
  96     ;; Fixed on 2001-3-3
  97     (pass-if-exception "(lambda (x x) 1)"
  98       exception:duplicate-formals
  99       (lambda (x x) 1))
 100
 101     ;; Fixed on 2001-3-3
 102     (pass-if-exception "(lambda (x x x) 1)"
 103       exception:duplicate-formals
 104       (lambda (x x x) 1))))
 105
 106 (with-test-prefix "let"
 107
 108   (with-test-prefix "bindings"
 109
 110     (pass-if-exception "late binding"
 111       exception:unbound-var
 112       (let ((x 1) (y x)) y)))
 113
 114   (with-test-prefix "bad body"
 115
 116     (pass-if-exception "(let ())"
 117       exception:bad-body
 118       (let ()))
 119
 120     (pass-if-exception "(let ((x 1)))"
 121       exception:bad-body
 122       (let ((x 1))))
 123
 124     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 125     ;; Hmm, the body is bad as well, isn't it?
 126     (pass-if-exception "(let)"
 127       exception:bad-body
 128       (let))
 129
 130     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 131     ;; Hmm, the body is bad as well, isn't it?
 132     (pass-if-exception "(let 1)"
 133       exception:bad-body
 134       (let 1))
 135
 136     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 137     ;; Hmm, the body is bad as well, isn't it?
 138     (pass-if-exception "(let (x))"
 139       exception:bad-body
 140       (let (x))))
 141
 142   (with-test-prefix "bad bindings"
 143
 144     (pass-if-exception "(let (x) 1)"
 145       exception:bad-bindings
 146       (let (x) 1))
 147
 148     (pass-if-exception "(let ((x)) 3)"
 149       exception:bad-bindings
 150       (let ((x)) 3))
 151
 152     (pass-if-exception "(let ((x 1) y) x)"
 153       exception:bad-bindings
 154       (let ((x 1) y) x))
 155
 156     (pass-if-exception "(let ((1 2)) 3)"
 157       exception:bad-var
 158       (let ((1 2)) 3)))
 159
 160   (with-test-prefix "duplicate bindings"
 161
 162     (pass-if-exception "(let ((x 1) (x 2)) x)"
 163       exception:duplicate-bindings
 164       (let ((x 1) (x 2)) x))))
 165
 166 (with-test-prefix "named let"
 167
 168   (with-test-prefix "bad body"
 169
 170     (pass-if-exception "(let x ())"
 171       exception:bad-body
 172       (let x ()))
 173
 174     (pass-if-exception "(let x ((y 1)))"
 175       exception:bad-body
 176       (let x ((y 1))))
 177
 178     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 179     ;; Hmm, the body is bad as well, isn't it?
 180     (pass-if-exception "(let x (y))"
 181       exception:bad-body
 182       (let x (y)))))
 183
 184 (with-test-prefix "let*"
 185
 186   (with-test-prefix "bindings"
 187
 188     (pass-if "(let* ((x 1) (x 2)) ...)"
 189       (let* ((x 1) (x 2))
 190         (= x 2)))
 191
 192     (pass-if "(let* ((x 1) (x x)) ...)"
 193       (let* ((x 1) (x x))
 194         (= x 1))))
 195
 196   (with-test-prefix "bad body"
 197
 198     (pass-if-exception "(let* ())"
 199       exception:bad-body
 200       (let* ()))
 201
 202     (pass-if-exception "(let* ((x 1)))"
 203       exception:bad-body
 204       (let* ((x 1))))
 205
 206     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 207     ;; Hmm, the body is bad as well, isn't it?
 208     (pass-if-exception "(let*)"
 209       exception:bad-body
 210       (let*))
 211
 212     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 213     ;; Hmm, the body is bad as well, isn't it?
 214     (pass-if-exception "(let* 1)"
 215       exception:bad-body
 216       (let* 1))
 217
 218     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 219     ;; Hmm, the body is bad as well, isn't it?
 220     (pass-if-exception "(let* (x))"
 221       exception:bad-body
 222       (let* (x))))
 223
 224   (with-test-prefix "bad bindings"
 225
 226     (pass-if-exception "(let* (x) 1)"
 227       exception:bad-bindings
 228       (let* (x) 1))
 229
 230     (pass-if-exception "(let* ((x)) 3)"
 231       exception:bad-bindings
 232       (let* ((x)) 3))
 233
 234     (pass-if-exception "(let* ((x 1) y) x)"
 235       exception:bad-bindings
 236       (let* ((x 1) y) x))
 237
 238     (pass-if-exception "(let* x ())"
 239       exception:bad-bindings
 240       (let* x ()))
 241
 242     (pass-if-exception "(let* x (y))"
 243       exception:bad-bindings
 244       (let* x (y)))
 245
 246     (pass-if-exception "(let* ((1 2)) 3)"
 247       exception:bad-var
 248       (let* ((1 2)) 3))))
 249
 250 (with-test-prefix "letrec"
 251
 252   (with-test-prefix "bindings"
 253
 254     (pass-if-exception "initial bindings are undefined"
 255       exception:unbound-var
 256       (let ((x 1))
 257         (letrec ((x 1) (y x)) y))))
 258
 259   (with-test-prefix "bad body"
 260
 261     (pass-if-exception "(letrec ())"
 262       exception:bad-body
 263       (letrec ()))
 264
 265     (pass-if-exception "(letrec ((x 1)))"
 266       exception:bad-body
 267       (letrec ((x 1))))
 268
 269     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 270     ;; Hmm, the body is bad as well, isn't it?
 271     (pass-if-exception "(letrec)"
 272       exception:bad-body
 273       (letrec))
 274
 275     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 276     ;; Hmm, the body is bad as well, isn't it?
 277     (pass-if-exception "(letrec 1)"
 278       exception:bad-body
 279       (letrec 1))
 280
 281     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 282     ;; Hmm, the body is bad as well, isn't it?
 283     (pass-if-exception "(letrec (x))"
 284       exception:bad-body
 285       (letrec (x))))
 286
 287   (with-test-prefix "bad bindings"
 288
 289     (pass-if-exception "(letrec (x) 1)"
 290       exception:bad-bindings
 291       (letrec (x) 1))
 292
 293     (pass-if-exception "(letrec ((x)) 3)"
 294       exception:bad-bindings
 295       (letrec ((x)) 3))
 296
 297     (pass-if-exception "(letrec ((x 1) y) x)"
 298       exception:bad-bindings
 299       (letrec ((x 1) y) x))
 300
 301     (pass-if-exception "(letrec x ())"
 302       exception:bad-bindings
 303       (letrec x ()))
 304
 305     (pass-if-exception "(letrec x (y))"
 306       exception:bad-bindings
 307       (letrec x (y)))
 308
 309     (pass-if-exception "(letrec ((1 2)) 3)"
 310       exception:bad-var
 311       (letrec ((1 2)) 3)))
 312
 313   (with-test-prefix "duplicate bindings"
 314
 315     (pass-if-exception "(letrec ((x 1) (x 2)) x)"
 316       exception:duplicate-bindings
 317       (letrec ((x 1) (x 2)) x))))
 318
 319 (with-test-prefix "if"
 320
 321   (with-test-prefix "missing or extra expressions"
 322
 323     (pass-if-exception "(if)"
 324       exception:missing/extra-expr
 325       (if))
 326
 327     (pass-if-exception "(if 1 2 3 4)"
 328       exception:missing/extra-expr
 329       (if 1 2 3 4))))
 330
 331 (with-test-prefix "cond"
 332
 333   (with-test-prefix "bad or missing clauses"
 334
 335     (pass-if-exception "(cond)"
 336       exception:bad/missing-clauses
 337       (cond))
 338
 339     (pass-if-exception "(cond #t)"
 340       exception:bad/missing-clauses
 341       (cond #t))
 342
 343     (pass-if-exception "(cond 1)"
 344       exception:bad/missing-clauses
 345       (cond 1))
 346
 347     (pass-if-exception "(cond 1 2)"
 348       exception:bad/missing-clauses
 349       (cond 1 2))
 350
 351     (pass-if-exception "(cond 1 2 3)"
 352       exception:bad/missing-clauses
 353       (cond 1 2 3))
 354
 355     (pass-if-exception "(cond 1 2 3 4)"
 356       exception:bad/missing-clauses
 357       (cond 1 2 3 4))
 358
 359     (pass-if-exception "(cond ())"
 360       exception:bad/missing-clauses
 361       (cond ()))
 362
 363     (pass-if-exception "(cond () 1)"
 364       exception:bad/missing-clauses
 365       (cond () 1))
 366
 367     (pass-if-exception "(cond (1) 1)"
 368       exception:bad/missing-clauses
 369       (cond (1) 1))))
 370
 371 (with-test-prefix "cond =>"
 372
 373   (with-test-prefix "else is handled correctly"
 374
 375     (pass-if "else =>"
 376       (let ((=> 'foo))
 377         (eq? (cond (else =>)) 'foo)))
 378
 379     (pass-if "else => identity"
 380       (let* ((=> 'foo))
 381         (eq? (cond (else => identity)) identity))))
 382
 383   (with-test-prefix "bad formals"
 384
 385     (pass-if-exception "=> (lambda (x 1) 2)"
 386       exception:bad-formals
 387       (cond (1 => (lambda (x 1) 2))))))
 388
 389 (with-test-prefix "case"
 390
 391   (with-test-prefix "bad or missing clauses"
 392
 393     (pass-if-exception "(case)"
 394       exception:bad/missing-clauses
 395       (case))
 396
 397     (pass-if-exception "(case . \"foo\")"
 398       exception:bad/missing-clauses
 399       (case . "foo"))
 400
 401     (pass-if-exception "(case 1)"
 402       exception:bad/missing-clauses
 403       (case 1))
 404
 405     (pass-if-exception "(case 1 . \"foo\")"
 406       exception:bad/missing-clauses
 407       (case 1 . "foo"))
 408
 409     (pass-if-exception "(case 1 \"foo\")"
 410       exception:bad/missing-clauses
 411       (case 1 "foo"))
 412
 413     (pass-if-exception "(case 1 ())"
 414       exception:bad/missing-clauses
 415       (case 1 ()))
 416
 417     (pass-if-exception "(case 1 (\"foo\"))"
 418       exception:bad/missing-clauses
 419       (case 1 ("foo")))
 420
 421     (pass-if-exception "(case 1 (\"foo\" \"bar\"))"
 422       exception:bad/missing-clauses
 423       (case 1 ("foo" "bar")))
 424
 425     ;; According to R5RS, the following one is syntactically correct.
 426     ;; (pass-if-exception "(case 1 (() \"bar\"))"
 427     ;;   exception:bad/missing-clauses
 428     ;;   (case 1 (() "bar")))
 429
 430     (pass-if-exception "(case 1 ((2) \"bar\") . \"foo\")"
 431       exception:bad/missing-clauses
 432       (case 1 ((2) "bar") . "foo"))
 433
 434     (pass-if-exception "(case 1 (else #f) ((1) #t))"
 435       exception:bad/missing-clauses
 436       (case 1 ((2) "bar") (else)))
 437
 438     (pass-if-exception "(case 1 (else #f) . \"foo\")"
 439       exception:bad/missing-clauses
 440       (case 1 (else #f) . "foo"))
 441
 442     (pass-if-exception "(case 1 (else #f) ((1) #t))"
 443       exception:bad/missing-clauses
 444       (case 1 (else #f) ((1) #t)))))
 445
 446 (with-test-prefix "define"
 447
 448   (with-test-prefix "missing or extra expressions"
 449
 450     (pass-if-exception "(define)"
 451       exception:missing/extra-expr
 452       (define))))
 453
 454 (with-test-prefix "set!"
 455
 456   (with-test-prefix "missing or extra expressions"
 457
 458     (pass-if-exception "(set!)"
 459       exception:missing/extra-expr
 460       (set!))
 461
 462     (pass-if-exception "(set! 1)"
 463       exception:missing/extra-expr
 464       (set! 1))
 465
 466     (pass-if-exception "(set! 1 2 3)"
 467       exception:missing/extra-expr
 468       (set! 1 2 3)))
 469
 470   (with-test-prefix "bad variable"
 471
 472     (pass-if-exception "(set! \"\" #t)"
 473       exception:bad-var
 474       (set! "" #t))
 475
 476     (pass-if-exception "(set! 1 #t)"
 477       exception:bad-var
 478       (set! 1 #t))
 479
 480     (pass-if-exception "(set! #t #f)"
 481       exception:bad-var
 482       (set! #t #f))
 483
 484     (pass-if-exception "(set! #f #t)"
 485       exception:bad-var
 486       (set! #f #t))
 487
 488     (pass-if-exception "(set! #\space #f)"
 489       exception:bad-var
 490       (set! #\space #f))))
 491
 492 (with-test-prefix "generalized set! (SRFI 17)"
 493
 494   (with-test-prefix "target is not procedure with setter"
 495
 496     (pass-if-exception "(set! (symbol->string 'x) 1)"
 497       exception:wrong-type-arg
 498       (set! (symbol->string 'x) 1))
 499
 500     (pass-if-exception "(set! '#f 1)"
 501       exception:wrong-type-arg
 502       (set! '#f 1))))
 503
 504 (with-test-prefix "quote"
 505
 506   (with-test-prefix "missing or extra expression"
 507
 508     (pass-if-exception "(quote)"
 509       exception:missing/extra-expr
 510       (quote))
 511
 512     (pass-if-exception "(quote a b)"
 513       exception:missing/extra-expr
 514       (quote a b))))