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:bad-body
  24   (cons 'misc-error "^bad body"))
  25 (define exception:bad-formals
  26   (cons 'misc-error "^bad formals"))
  27 (define exception:bad-var
  28   (cons 'misc-error "^bad variable"))
  29 (define exception:bad/missing-clauses
  30   (cons 'misc-error "^bad or missing clauses"))
  31 (define exception:missing/extra-expr
  32   (cons 'misc-error "^missing or extra expression"))
  33
  34
  35 (with-test-prefix "expressions"
  36
  37   (with-test-prefix "missing or extra expression"
  38
  39     ;; R5RS says:
  40     ;; *Note:* In many dialects of Lisp, the empty combination, (),
  41     ;; is a legitimate expression.  In Scheme, combinations must
  42     ;; have at least one subexpression, so () is not a syntactically
  43     ;; valid expression.
  44     (expect-fail-exception "empty parentheses \"()\""
  45       exception:missing/extra-expr
  46       ())))
  47
  48 (with-test-prefix "lambda"
  49
  50   (with-test-prefix "bad formals"
  51
  52     (pass-if-exception "(lambda (x 1) 2)"
  53       exception:bad-formals
  54       (lambda (x 1) 2))
  55
  56     (pass-if-exception "(lambda (1 x) 2)"
  57       exception:bad-formals
  58       (lambda (1 x) 2))
  59
  60     (pass-if-exception "(lambda (x \"a\") 2)"
  61       exception:bad-formals
  62       (lambda (x "a") 2))
  63
  64     (pass-if-exception "(lambda (\"a\" x) 2)"
  65       exception:bad-formals
  66       (lambda ("a" x) 2))
  67
  68     (expect-fail-exception "(lambda (x x) 1)"
  69       exception:bad-formals
  70       (lambda (x x) 1))
  71
  72     (expect-fail-exception "(lambda (x x x) 1)"
  73       exception:bad-formals
  74       (lambda (x x x) 1))))
  75
  76 (with-test-prefix "let"
  77
  78   (with-test-prefix "bindings"
  79
  80     (pass-if-exception "late binding"
  81       exception:unbound-var
  82       (let ((x 1) (y x)) y)))
  83
  84   (with-test-prefix "bad body"
  85
  86     (pass-if-exception "(let ())"
  87       exception:bad-body
  88       (let ()))
  89
  90     (pass-if-exception "(let ((x 1)))"
  91       exception:bad-body
  92       (let ((x 1))))
  93
  94     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
  95     (pass-if-exception "(let)"
  96       exception:bad-body
  97       (let))
  98
  99     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 100     (pass-if-exception "(let 1)"
 101       exception:bad-body
 102       (let 1))
 103
 104     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 105     (pass-if-exception "(let (x))"
 106       exception:bad-body
 107       (let (x))))
 108
 109   (with-test-prefix "bad bindings"
 110
 111     (pass-if-exception "(let (x) 1)"
 112       exception:bad-bindings
 113       (let (x) 1))
 114
 115     (pass-if-exception "(let ((x)) 3)"
 116       exception:bad-bindings
 117       (let ((x)) 3))
 118
 119     (pass-if-exception "(let ((x 1) y) x)"
 120       exception:bad-bindings
 121       (let ((x 1) y) x))
 122
 123     (pass-if-exception "(let ((1 2)) 3)"
 124       exception:bad-var
 125       (let ((1 2)) 3))
 126
 127     (expect-fail-exception "(let ((x 1) (x 2)) x)"
 128       exception:bad-bindings
 129       (let ((x 1) (x 2)) x))))
 130
 131 (with-test-prefix "named let"
 132
 133   (with-test-prefix "bad body"
 134
 135     (pass-if-exception "(let x ())"
 136       exception:bad-body
 137       (let x ()))
 138
 139     (pass-if-exception "(let x ((y 1)))"
 140       exception:bad-body
 141       (let x ((y 1))))
 142
 143     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 144     (pass-if-exception "(let x (y))"
 145       exception:bad-body
 146       (let x (y)))))
 147
 148 (with-test-prefix "let*"
 149
 150   (with-test-prefix "bad body"
 151
 152     (pass-if-exception "(let* ())"
 153       exception:bad-body
 154       (let* ()))
 155
 156     (pass-if-exception "(let* ((x 1)))"
 157       exception:bad-body
 158       (let* ((x 1))))
 159
 160     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 161     (pass-if-exception "(let*)"
 162       exception:bad-body
 163       (let*))
 164
 165     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 166     (pass-if-exception "(let* 1)"
 167       exception:bad-body
 168       (let* 1))
 169
 170     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 171     (pass-if-exception "(let* (x))"
 172       exception:bad-body
 173       (let* (x))))
 174
 175   (with-test-prefix "bad bindings"
 176
 177     (pass-if-exception "(let* (x) 1)"
 178       exception:bad-bindings
 179       (let* (x) 1))
 180
 181     (pass-if-exception "(let* ((x)) 3)"
 182       exception:bad-bindings
 183       (let* ((x)) 3))
 184
 185     (pass-if-exception "(let* ((x 1) y) x)"
 186       exception:bad-bindings
 187       (let* ((x 1) y) x))
 188
 189     (pass-if-exception "(let* x ())"
 190       exception:bad-bindings
 191       (let* x ()))
 192
 193     (pass-if-exception "(let* x (y))"
 194       exception:bad-bindings
 195       (let* x (y)))
 196
 197     (pass-if-exception "(let* ((1 2)) 3)"
 198       exception:bad-var
 199       (let* ((1 2)) 3))
 200
 201     (expect-fail-exception "(let* ((x 1) (x 2)) x)"
 202       exception:bad-bindings
 203       (let* ((x 1) (x 2)) x))))
 204
 205 (with-test-prefix "letrec"
 206
 207   (with-test-prefix "bindings"
 208
 209     (pass-if-exception "initial bindings are undefined"
 210       exception:unbound-var
 211       (let ((x 1))
 212         (letrec ((x 1) (y x)) y))))
 213
 214   (with-test-prefix "bad body"
 215
 216     (pass-if-exception "(letrec ())"
 217       exception:bad-body
 218       (letrec ()))
 219
 220     (pass-if-exception "(letrec ((x 1)))"
 221       exception:bad-body
 222       (letrec ((x 1))))
 223
 224     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 225     (pass-if-exception "(letrec)"
 226       exception:bad-body
 227       (letrec))
 228
 229     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 230     (pass-if-exception "(letrec 1)"
 231       exception:bad-body
 232       (letrec 1))
 233
 234     ;; FIXME:  Wouldn't one rather expect a 'bad bindings' error?
 235     (pass-if-exception "(letrec (x))"
 236       exception:bad-body
 237       (letrec (x))))
 238
 239   (with-test-prefix "bad bindings"
 240
 241     (pass-if-exception "(letrec (x) 1)"
 242       exception:bad-bindings
 243       (letrec (x) 1))
 244
 245     (pass-if-exception "(letrec ((x)) 3)"
 246       exception:bad-bindings
 247       (letrec ((x)) 3))
 248
 249     (pass-if-exception "(letrec ((x 1) y) x)"
 250       exception:bad-bindings
 251       (letrec ((x 1) y) x))
 252
 253     (pass-if-exception "(letrec x ())"
 254       exception:bad-bindings
 255       (letrec x ()))
 256
 257     (pass-if-exception "(letrec x (y))"
 258       exception:bad-bindings
 259       (letrec x (y)))
 260
 261     (pass-if-exception "(letrec ((1 2)) 3)"
 262       exception:bad-var
 263       (letrec ((1 2)) 3))
 264
 265     (expect-fail-exception "(letrec ((x 1) (x 2)) x)"
 266       exception:bad-bindings
 267       (letrec ((x 1) (x 2)) x))))
 268
 269 (with-test-prefix "if"
 270
 271   (with-test-prefix "missing or extra expressions"
 272
 273     (pass-if-exception "(if)"
 274       exception:missing/extra-expr
 275       (if))
 276
 277     (pass-if-exception "(if 1 2 3 4)"
 278       exception:missing/extra-expr
 279       (if 1 2 3 4))))
 280
 281 (with-test-prefix "cond"
 282
 283   (with-test-prefix "bad or missing clauses"
 284
 285     (pass-if-exception "(cond)"
 286       exception:bad/missing-clauses
 287       (cond))
 288
 289     (pass-if-exception "(cond #t)"
 290       exception:bad/missing-clauses
 291       (cond #t))
 292
 293     (pass-if-exception "(cond 1)"
 294       exception:bad/missing-clauses
 295       (cond 1))
 296
 297     (pass-if-exception "(cond 1 2)"
 298       exception:bad/missing-clauses
 299       (cond 1 2))
 300
 301     (pass-if-exception "(cond 1 2 3)"
 302       exception:bad/missing-clauses
 303       (cond 1 2 3))
 304
 305     (pass-if-exception "(cond 1 2 3 4)"
 306       exception:bad/missing-clauses
 307       (cond 1 2 3 4))
 308
 309     (pass-if-exception "(cond ())"
 310       exception:bad/missing-clauses
 311       (cond ()))
 312
 313     (pass-if-exception "(cond () 1)"
 314       exception:bad/missing-clauses
 315       (cond () 1))
 316
 317     (pass-if-exception "(cond (1) 1)"
 318       exception:bad/missing-clauses
 319       (cond (1) 1))))
 320
 321 (with-test-prefix "cond =>"
 322
 323   (with-test-prefix "bad formals"
 324
 325     (pass-if-exception "=> (lambda (x 1) 2)"
 326       exception:bad-formals
 327       (cond (1 => (lambda (x 1) 2))))))
 328
 329 (with-test-prefix "define"
 330
 331   (with-test-prefix "missing or extra expressions"
 332
 333     (pass-if-exception "(define)"
 334       exception:missing/extra-expr
 335       (define))))
 336
 337 (with-test-prefix "set!"
 338
 339   (with-test-prefix "missing or extra expressions"
 340
 341     (pass-if-exception "(set!)"
 342       exception:missing/extra-expr
 343       (set!))
 344
 345     (pass-if-exception "(set! 1)"
 346       exception:missing/extra-expr
 347       (set! 1))
 348
 349     (pass-if-exception "(set! 1 2 3)"
 350       exception:missing/extra-expr
 351       (set! 1 2 3)))
 352
 353   (with-test-prefix "bad variable"
 354
 355     (pass-if-exception "(set! \"\" #t)"
 356       exception:bad-var
 357       (set! "" #t))
 358
 359     (pass-if-exception "(set! 1 #t)"
 360       exception:bad-var
 361       (set! 1 #t))
 362
 363     (pass-if-exception "(set! #t #f)"
 364       exception:bad-var
 365       (set! #t #f))
 366
 367     (pass-if-exception "(set! #f #t)"
 368       exception:bad-var
 369       (set! #f #t))
 370
 371     (pass-if-exception "(set! #\space #f)"
 372       exception:bad-var
 373       (set! #\space #f))))
 374
 375 (with-test-prefix "generalized set! (SRFI 17)"
 376
 377   (with-test-prefix "target is not procedure with setter"
 378
 379     (pass-if-exception "(set! (symbol->string 'x) 1)"
 380       exception:wrong-type-arg
 381       (set! (symbol->string 'x) 1))
 382
 383     (pass-if-exception "(set! '#f 1)"
 384       exception:wrong-type-arg
 385       (set! '#f 1))))
 386
 387 (with-test-prefix "quote"
 388
 389   (with-test-prefix "missing or extra expression"
 390
 391     (pass-if-exception "(quote)"
 392       exception:missing/extra-expr
 393       (quote))
 394
 395     (pass-if-exception "(quote a b)"
 396       exception:missing/extra-expr
 397       (quote a b))))