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 "bad body"
 167
 168     (pass-if-exception "(let* ())"
 169       exception:bad-body
 170       (let* ()))
 171
 172     (pass-if-exception "(let* ((x 1)))"
 173       exception:bad-body
 174       (let* ((x 1))))
 175
 176     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 177     ;; Hmm, the body is bad as well, isn't it?
 178     (pass-if-exception "(let*)"
 179       exception:bad-body
 180       (let*))
 181
 182     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 183     ;; Hmm, the body is bad as well, isn't it?
 184     (pass-if-exception "(let* 1)"
 185       exception:bad-body
 186       (let* 1))
 187
 188     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 189     ;; Hmm, the body is bad as well, isn't it?
 190     (pass-if-exception "(let* (x))"
 191       exception:bad-body
 192       (let* (x))))
 193
 194   (with-test-prefix "bad bindings"
 195
 196     (pass-if-exception "(let* (x) 1)"
 197       exception:bad-bindings
 198       (let* (x) 1))
 199
 200     (pass-if-exception "(let* ((x)) 3)"
 201       exception:bad-bindings
 202       (let* ((x)) 3))
 203
 204     (pass-if-exception "(let* ((x 1) y) x)"
 205       exception:bad-bindings
 206       (let* ((x 1) y) x))
 207
 208     (pass-if-exception "(let* x ())"
 209       exception:bad-bindings
 210       (let* x ()))
 211
 212     (pass-if-exception "(let* x (y))"
 213       exception:bad-bindings
 214       (let* x (y)))
 215
 216     (pass-if-exception "(let* ((1 2)) 3)"
 217       exception:bad-var
 218       (let* ((1 2)) 3)))
 219
 220   (with-test-prefix "duplicate bindings"
 221
 222     (pass-if-exception "(let* ((x 1) (x 2)) x)"
 223       exception:duplicate-bindings
 224       (let* ((x 1) (x 2)) x))))
 225
 226 (with-test-prefix "letrec"
 227
 228   (with-test-prefix "bindings"
 229
 230     (pass-if-exception "initial bindings are undefined"
 231       exception:unbound-var
 232       (let ((x 1))
 233         (letrec ((x 1) (y x)) y))))
 234
 235   (with-test-prefix "bad body"
 236
 237     (pass-if-exception "(letrec ())"
 238       exception:bad-body
 239       (letrec ()))
 240
 241     (pass-if-exception "(letrec ((x 1)))"
 242       exception:bad-body
 243       (letrec ((x 1))))
 244
 245     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 246     ;; Hmm, the body is bad as well, isn't it?
 247     (pass-if-exception "(letrec)"
 248       exception:bad-body
 249       (letrec))
 250
 251     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 252     ;; Hmm, the body is bad as well, isn't it?
 253     (pass-if-exception "(letrec 1)"
 254       exception:bad-body
 255       (letrec 1))
 256
 257     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 258     ;; Hmm, the body is bad as well, isn't it?
 259     (pass-if-exception "(letrec (x))"
 260       exception:bad-body
 261       (letrec (x))))
 262
 263   (with-test-prefix "bad bindings"
 264
 265     (pass-if-exception "(letrec (x) 1)"
 266       exception:bad-bindings
 267       (letrec (x) 1))
 268
 269     (pass-if-exception "(letrec ((x)) 3)"
 270       exception:bad-bindings
 271       (letrec ((x)) 3))
 272
 273     (pass-if-exception "(letrec ((x 1) y) x)"
 274       exception:bad-bindings
 275       (letrec ((x 1) y) x))
 276
 277     (pass-if-exception "(letrec x ())"
 278       exception:bad-bindings
 279       (letrec x ()))
 280
 281     (pass-if-exception "(letrec x (y))"
 282       exception:bad-bindings
 283       (letrec x (y)))
 284
 285     (pass-if-exception "(letrec ((1 2)) 3)"
 286       exception:bad-var
 287       (letrec ((1 2)) 3)))
 288
 289   (with-test-prefix "duplicate bindings"
 290
 291     (pass-if-exception "(letrec ((x 1) (x 2)) x)"
 292       exception:duplicate-bindings
 293       (letrec ((x 1) (x 2)) x))))
 294
 295 (with-test-prefix "if"
 296
 297   (with-test-prefix "missing or extra expressions"
 298
 299     (pass-if-exception "(if)"
 300       exception:missing/extra-expr
 301       (if))
 302
 303     (pass-if-exception "(if 1 2 3 4)"
 304       exception:missing/extra-expr
 305       (if 1 2 3 4))))
 306
 307 (with-test-prefix "cond"
 308
 309   (with-test-prefix "bad or missing clauses"
 310
 311     (pass-if-exception "(cond)"
 312       exception:bad/missing-clauses
 313       (cond))
 314
 315     (pass-if-exception "(cond #t)"
 316       exception:bad/missing-clauses
 317       (cond #t))
 318
 319     (pass-if-exception "(cond 1)"
 320       exception:bad/missing-clauses
 321       (cond 1))
 322
 323     (pass-if-exception "(cond 1 2)"
 324       exception:bad/missing-clauses
 325       (cond 1 2))
 326
 327     (pass-if-exception "(cond 1 2 3)"
 328       exception:bad/missing-clauses
 329       (cond 1 2 3))
 330
 331     (pass-if-exception "(cond 1 2 3 4)"
 332       exception:bad/missing-clauses
 333       (cond 1 2 3 4))
 334
 335     (pass-if-exception "(cond ())"
 336       exception:bad/missing-clauses
 337       (cond ()))
 338
 339     (pass-if-exception "(cond () 1)"
 340       exception:bad/missing-clauses
 341       (cond () 1))
 342
 343     (pass-if-exception "(cond (1) 1)"
 344       exception:bad/missing-clauses
 345       (cond (1) 1))))
 346
 347 (with-test-prefix "cond =>"
 348
 349   (with-test-prefix "bad formals"
 350
 351     (pass-if-exception "=> (lambda (x 1) 2)"
 352       exception:bad-formals
 353       (cond (1 => (lambda (x 1) 2))))))
 354
 355 (with-test-prefix "define"
 356
 357   (with-test-prefix "missing or extra expressions"
 358
 359     (pass-if-exception "(define)"
 360       exception:missing/extra-expr
 361       (define))))
 362
 363 (with-test-prefix "set!"
 364
 365   (with-test-prefix "missing or extra expressions"
 366
 367     (pass-if-exception "(set!)"
 368       exception:missing/extra-expr
 369       (set!))
 370
 371     (pass-if-exception "(set! 1)"
 372       exception:missing/extra-expr
 373       (set! 1))
 374
 375     (pass-if-exception "(set! 1 2 3)"
 376       exception:missing/extra-expr
 377       (set! 1 2 3)))
 378
 379   (with-test-prefix "bad variable"
 380
 381     (pass-if-exception "(set! \"\" #t)"
 382       exception:bad-var
 383       (set! "" #t))
 384
 385     (pass-if-exception "(set! 1 #t)"
 386       exception:bad-var
 387       (set! 1 #t))
 388
 389     (pass-if-exception "(set! #t #f)"
 390       exception:bad-var
 391       (set! #t #f))
 392
 393     (pass-if-exception "(set! #f #t)"
 394       exception:bad-var
 395       (set! #f #t))
 396
 397     (pass-if-exception "(set! #\space #f)"
 398       exception:bad-var
 399       (set! #\space #f))))
 400
 401 (with-test-prefix "generalized set! (SRFI 17)"
 402
 403   (with-test-prefix "target is not procedure with setter"
 404
 405     (pass-if-exception "(set! (symbol->string 'x) 1)"
 406       exception:wrong-type-arg
 407       (set! (symbol->string 'x) 1))
 408
 409     (pass-if-exception "(set! '#f 1)"
 410       exception:wrong-type-arg
 411       (set! '#f 1))))
 412
 413 (with-test-prefix "quote"
 414
 415   (with-test-prefix "missing or extra expression"
 416
 417     (pass-if-exception "(quote)"
 418       exception:missing/extra-expr
 419       (quote))
 420
 421     (pass-if-exception "(quote a b)"
 422       exception:missing/extra-expr
 423       (quote a b))))