1;; Filename : test-begin.scm 2;; About : unit test for R5RS begin 3;; 4;; Copyright (C) 2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp> 5;; Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com> 6;; 7;; All rights reserved. 8;; 9;; Redistribution and use in source and binary forms, with or without 10;; modification, are permitted provided that the following conditions 11;; are met: 12;; 13;; 1. Redistributions of source code must retain the above copyright 14;; notice, this list of conditions and the following disclaimer. 15;; 2. Redistributions in binary form must reproduce the above copyright 16;; notice, this list of conditions and the following disclaimer in the 17;; documentation and/or other materials provided with the distribution. 18;; 3. Neither the name of authors nor the names of its contributors 19;; may be used to endorse or promote products derived from this software 20;; without specific prior written permission. 21;; 22;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS 23;; IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 24;; THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 25;; PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR 26;; CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 27;; EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 28;; PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 29;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 30;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 31;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 32;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 33 34(require-extension (unittest)) 35 36(define *test-track-progress* #f) 37(define tn test-name) 38 39;; R5RS: 7.1.6 Programs and definitions 40;; 41;; <program> --> <command or definition>* 42;; <command or definition> --> <command> 43;; | <definition> 44;; | <syntax definition> 45;; | (begin <command or definition>+) 46;; <definition> --> (define <variable> <expression>) 47;; | (define (<variable> <def formals>) <body>) 48;; | (begin <definition>*) 49;; <def formals> --> <variable>* 50;; | <variable>* . <variable> 51;; <syntax definition> --> 52;; (define-syntax <keyword> <transformer spec>) 53 54(tn "top-level begin invalid forms") 55;; 'if', 'and', 'or', 'cond', 'case' do not make environment so these 56;; '(begin)'s are not internal definitions and invalid. 57;; See also test-do.scm for more invalid definitions. 58;; See also test-define.scm for top-level definitions. 59(if (provided? "strict-toplevel-definitions") 60 (begin 61 (assert-error (tn) 62 (lambda () 63 (eval '(if #t (begin)) 64 (interaction-environment)))) 65 (assert-error (tn) 66 (lambda () 67 (eval '(if #f #t (begin)) 68 (interaction-environment)))) 69 (assert-error (tn) 70 (lambda () 71 (eval '(and (begin)) 72 (interaction-environment)))) 73 (assert-error (tn) 74 (lambda () 75 (eval '(or (begin)) 76 (interaction-environment)))) 77 (assert-error (tn) 78 (lambda () 79 (eval '(cond (#t (begin))) 80 (interaction-environment)))) 81 (assert-error (tn) 82 (lambda () 83 (eval '(cond (else (begin))) 84 (interaction-environment)))) 85 (assert-error (tn) 86 (lambda () 87 (eval '(case 'key (#t (begin))) 88 (interaction-environment)))) 89 (assert-error (tn) 90 (lambda () 91 (eval '(case 'key (else (begin))) 92 (interaction-environment)))))) 93 94(tn "top-level begin invalid forms (strict)") 95(if (provided? "strict-toplevel-definitions") 96 (begin 97 (assert-error (tn) 98 (lambda () 99 (eval '(if #t (begin (define var0 1))) 100 (interaction-environment)))) 101 (assert-error (tn) 102 (lambda () 103 (eval '(if #t (begin (define var0 1) #t)) 104 (interaction-environment)))) 105 (assert-error (tn) 106 (lambda () 107 (eval '(if #f #t (begin (define var0 1))) 108 (interaction-environment)))) 109 (assert-error (tn) 110 (lambda () 111 (eval '(if #f #t (begin (define var0 1) #t)) 112 (interaction-environment)))) 113 (assert-error (tn) 114 (lambda () 115 (eval '(and (begin (define var0 1))) 116 (interaction-environment)))) 117 (assert-error (tn) 118 (lambda () 119 (eval '(and (begin (define var0 1) #t)) 120 (interaction-environment)))) 121 (assert-error (tn) 122 (lambda () 123 (eval '(or (begin (define var0 1))) 124 (interaction-environment)))) 125 (assert-error (tn) 126 (lambda () 127 (eval '(or (begin (define var0 1) #t)) 128 (interaction-environment)))) 129 (assert-error (tn) 130 (lambda () 131 (eval '(cond (#t (begin (define var0 1)))) 132 (interaction-environment)))) 133 (assert-error (tn) 134 (lambda () 135 (eval '(cond (#t (begin (define var0 1) #t))) 136 (interaction-environment)))) 137 (assert-error (tn) 138 (lambda () 139 (eval '(cond (else (begin (define var0 1)))) 140 (interaction-environment)))) 141 (assert-error (tn) 142 (lambda () 143 (eval '(cond (else (begin (define var0 1) #t))) 144 (interaction-environment)))) 145 (assert-error (tn) 146 (lambda () 147 (eval '(case 'key ((key) (begin (define var0 1)))) 148 (interaction-environment)))) 149 (assert-error (tn) 150 (lambda () 151 (eval '(case 'key ((key) (begin (define var0 1) #t))) 152 (interaction-environment)))) 153 (assert-error (tn) 154 (lambda () 155 (eval '(case 'key (else (begin (define var0 1)))) 156 (interaction-environment)))) 157 (assert-error (tn) 158 (lambda () 159 (eval '(case 'key (else (begin (define var0 1) #t))) 160 (interaction-environment)))))) 161 162(tn "top-level begin invalid forms (strict) 2") 163;; top-level define cannot be placed under a non-begin structure even if 164;; wrapped into top-level begin. 165(if (provided? "strict-toplevel-definitions") 166 (begin 167 (assert-error (tn) 168 (lambda () 169 (eval '(begin (if #t (begin (define var0 1)))) 170 (interaction-environment)))) 171 (assert-error (tn) 172 (lambda () 173 (eval '(begin (if #t (begin (define var0 1) #t))) 174 (interaction-environment)))) 175 (assert-error (tn) 176 (lambda () 177 (eval '(begin (if #f #t (begin (define var0 1)))) 178 (interaction-environment)))) 179 (assert-error (tn) 180 (lambda () 181 (eval '(begin (if #f #t (begin (define var0 1) #t))) 182 (interaction-environment)))) 183 (assert-error (tn) 184 (lambda () 185 (eval '(begin (and (begin (define var0 1)))) 186 (interaction-environment)))) 187 (assert-error (tn) 188 (lambda () 189 (eval '(begin (and (begin (define var0 1) #t))) 190 (interaction-environment)))) 191 (assert-error (tn) 192 (lambda () 193 (eval '(begin (or (begin (define var0 1)))) 194 (interaction-environment)))) 195 (assert-error (tn) 196 (lambda () 197 (eval '(begin (or (begin (define var0 1) #t))) 198 (interaction-environment)))) 199 (assert-error (tn) 200 (lambda () 201 (eval '(begin (cond (#t (begin (define var0 1))))) 202 (interaction-environment)))) 203 (assert-error (tn) 204 (lambda () 205 (eval '(begin (cond (#t (begin (define var0 1) #t)))) 206 (interaction-environment)))) 207 (assert-error (tn) 208 (lambda () 209 (eval '(begin (cond (else (begin (define var0 1))))) 210 (interaction-environment)))) 211 (assert-error (tn) 212 (lambda () 213 (eval '(begin (cond (else (begin (define var0 1) #t)))) 214 (interaction-environment)))) 215 (assert-error (tn) 216 (lambda () 217 (eval '(begin (case 'key 218 ((key) (begin (define var0 1))))) 219 (interaction-environment)))) 220 (assert-error (tn) 221 (lambda () 222 (eval '(begin (case 'key 223 ((key) (begin (define var0 1) #t)))) 224 (interaction-environment)))) 225 (assert-error (tn) 226 (lambda () 227 (eval '(begin (case 'key 228 (else (begin (define var0 1))))) 229 (interaction-environment)))) 230 (assert-error (tn) 231 (lambda () 232 (eval '(begin (case 'key 233 (else (begin (define var0 1) #t)))) 234 (interaction-environment)))))) 235 236(tn "top-level begin invalid forms (strict) 3") 237(if (provided? "strict-toplevel-definitions") 238 (begin 239 ;; top-level define cannot be placed under a non-begin structure even if 240 ;; wrapped into top-level begin. 241 (assert-error (tn) 242 (lambda () 243 (eval '(begin (if #t (define var0 1))) 244 (interaction-environment)))) 245 (assert-error (tn) 246 (lambda () 247 (eval '(begin (if #f #t (define var0 1))) 248 (interaction-environment)))) 249 (assert-error (tn) 250 (lambda () 251 (eval '(begin (and (define var0 1))) 252 (interaction-environment)))) 253 (assert-error (tn) 254 (lambda () 255 (eval '(begin (or (define var0 1))) 256 (interaction-environment)))) 257 (assert-error (tn) 258 (lambda () 259 (eval '(begin (cond (#t (define var0 1)))) 260 (interaction-environment)))) 261 (assert-error (tn) 262 (lambda () 263 (eval '(begin (cond (else (define var0 1)))) 264 (interaction-environment)))) 265 (assert-error (tn) 266 (lambda () 267 (eval '(begin (case 'key ((key) (define var0 1)))) 268 (interaction-environment)))) 269 (assert-error (tn) 270 (lambda () 271 (eval '(begin (case 'key (else (define var0 1)))) 272 (interaction-environment)))) 273 ;; test being evaled at non-tail part of 'begin' 274 (assert-error (tn) 275 (lambda () 276 (eval '(begin (if #t (define var0 1)) #t) 277 (interaction-environment)))) 278 (assert-error (tn) 279 (lambda () 280 (eval '(begin (if #f #t (define var0 1)) #t) 281 (interaction-environment)))) 282 (assert-error (tn) 283 (lambda () 284 (eval '(begin (and (define var0 1)) #t) 285 (interaction-environment)))) 286 (assert-error (tn) 287 (lambda () 288 (eval '(begin (or (define var0 1)) #t) 289 (interaction-environment)))) 290 (assert-error (tn) 291 (lambda () 292 (eval '(begin (cond (#t (define var0 1))) #t) 293 (interaction-environment)))) 294 (assert-error (tn) 295 (lambda () 296 (eval '(begin (cond (else (define var0 1))) #t) 297 (interaction-environment)))) 298 (assert-error (tn) 299 (lambda () 300 (eval '(begin (case 'key ((key) (define var0 1))) #t) 301 (interaction-environment)))) 302 (assert-error (tn) 303 (lambda () 304 (eval '(begin (case 'key (else (define var0 1))) #t) 305 (interaction-environment)))))) 306 307 308(tn "top-level begin valid forms") 309;; '(begin)' is allowd at toplevel 310(if (provided? "sigscheme") 311 (begin 312 (assert-equal? (tn) 313 (undef) 314 (eval '(begin) 315 (interaction-environment))) 316 (assert-equal? (tn) 317 (undef) 318 (eval '(begin (begin)) 319 (interaction-environment))))) 320;; 'begin' does not create an environment 321(assert-false (tn) (symbol-bound? 'var1)) 322(begin 323 (define var1 1)) 324(assert-equal? (tn) 1 var1) 325;; duplicate definition is allowed 326(begin 327 (define var1 3)) 328(assert-equal? (tn) 3 var1) 329(begin 330 (define var1 4) 331 (define var1 5)) 332(assert-equal? (tn) 5 var1) 333;; intermixing expression and definition on top-level is valid 334(begin 335 (+ 1 2) 336 (define var2 1)) 337(assert-equal? (tn) 1 var2) 338(begin 339 (define var3 1) 340 (+ 1 2)) 341(assert-equal? (tn) 1 var3) 342(begin 343 (define var4 1) 344 (+ 1 2) 345 (begin 346 (define var5 1))) 347(assert-equal? (tn) 1 var4) 348(assert-equal? (tn) 1 var5) 349 350 351(total-report) 352