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