1;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*- 2;;;; Martin Grabmueller, 2001-05-10 3;;;; 4;;;; Copyright (C) 2001, 2006, 2007, 2010, 2011, 2012, 5;;;; 2013 Free Software Foundation, Inc. 6;;;; 7;;;; This library is free software; you can redistribute it and/or 8;;;; modify it under the terms of the GNU Lesser General Public 9;;;; License as published by the Free Software Foundation; either 10;;;; version 3 of the License, or (at your option) any later version. 11;;;; 12;;;; This library is distributed in the hope that it will be useful, 13;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15;;;; Lesser General Public License for more details. 16;;;; 17;;;; You should have received a copy of the GNU Lesser General Public 18;;;; License along with this library; if not, write to the Free Software 19;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 20 21(define-module (test-suite test-numbers) 22 #:use-module (test-suite lib) 23 #:use-module ((system base compile) #:select (compile)) 24 #:use-module (srfi srfi-26) 25 #:use-module (srfi srfi-9) 26 #:use-module (srfi srfi-9 gnu)) 27 28 29(define-record-type :qux (make-qux) qux?) 30 31(define-record-type :foo (make-foo x) foo? 32 (x foo-x) 33 (y foo-y set-foo-y!) 34 (z foo-z set-foo-z!)) 35 36(define-record-type :bar (make-bar i j) bar? 37 (i bar-i) 38 (j bar-j set-bar-j!)) 39 40(define f (make-foo 1)) 41(set-foo-y! f 2) 42 43(define b (make-bar 123 456)) 44 45(define exception:syntax-error-wrong-num-args 46 (cons 'syntax-error "Wrong number of arguments")) 47 48(with-test-prefix "constructor" 49 50 ;; Constructors are defined using `define-integrable', meaning that direct 51 ;; calls as in `(make-foo)' lead to a compile-time psyntax error, hence the 52 ;; distinction below. 53 54 (pass-if-exception "foo 0 args (inline)" exception:syntax-error-wrong-num-args 55 (compile '(make-foo) #:env (current-module))) 56 (pass-if-exception "foo 2 args (inline)" exception:syntax-error-wrong-num-args 57 (compile '(make-foo 1 2) #:env (current-module))) 58 59 (pass-if-exception "foo 0 args" exception:wrong-num-args 60 (let ((make-foo make-foo)) 61 (make-foo))) 62 (pass-if-exception "foo 2 args" exception:wrong-num-args 63 (let ((make-foo make-foo)) 64 (make-foo 1 2)))) 65 66(with-test-prefix "predicate" 67 68 (pass-if "pass" 69 (foo? f)) 70 (pass-if "fail wrong record type" 71 (eq? #f (foo? b))) 72 (pass-if "fail number" 73 (eq? #f (foo? 123)))) 74 75(with-test-prefix "getter" 76 77 (pass-if "foo-x" 78 (= 1 (foo-x f))) 79 (pass-if "foo-y" 80 (= 2 (foo-y f))) 81 82 (pass-if-exception "foo-x on number" exception:wrong-type-arg 83 (foo-x 999)) 84 (pass-if-exception "foo-y on number" exception:wrong-type-arg 85 (foo-y 999)) 86 87 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced 88 (pass-if-exception "foo-x on bar" exception:wrong-type-arg 89 (foo-x b)) 90 (pass-if-exception "foo-y on bar" exception:wrong-type-arg 91 (foo-y b))) 92 93(with-test-prefix "setter" 94 95 (pass-if "set-foo-y!" 96 (set-foo-y! f #t) 97 (eq? #t (foo-y f))) 98 99 (pass-if-exception "set-foo-y! on number" exception:wrong-type-arg 100 (set-foo-y! 999 #t)) 101 102 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced 103 (pass-if-exception "set-foo-y! on bar" exception:wrong-type-arg 104 (set-foo-y! b 99))) 105 106(with-test-prefix "functional setters" 107 108 (pass-if "set-field" 109 (let ((s (make-foo (make-bar 1 2)))) 110 (and (equal? (set-field s (foo-x bar-j) 3) 111 (make-foo (make-bar 1 3))) 112 (equal? (set-field s (foo-z) 'bar) 113 (let ((s2 (make-foo (make-bar 1 2)))) 114 (set-foo-z! s2 'bar) 115 s2)) 116 (equal? s (make-foo (make-bar 1 2)))))) 117 118 (pass-if-exception "set-field on wrong struct type" exception:wrong-type-arg 119 (let ((s (make-bar (make-foo 5) 2))) 120 (set-field s (foo-x bar-j) 3))) 121 122 (pass-if-exception "set-field on number" exception:wrong-type-arg 123 (set-field 4 (foo-x bar-j) 3)) 124 125 (pass-if-equal "set-field with unknown first getter" 126 '(syntax-error set-fields "unknown getter" 127 (set-field s (blah) 3) 128 blah) 129 (catch 'syntax-error 130 (lambda () 131 (compile '(let ((s (make-bar (make-foo 5) 2))) 132 (set-field s (blah) 3)) 133 #:env (current-module)) 134 #f) 135 (lambda (key whom what src form subform) 136 (list key whom what form subform)))) 137 138 (pass-if-equal "set-field with unknown second getter" 139 '(syntax-error set-fields "unknown getter" 140 (set-field s (bar-j blah) 3) 141 blah) 142 (catch 'syntax-error 143 (lambda () 144 (compile '(let ((s (make-bar (make-foo 5) 2))) 145 (set-field s (bar-j blah) 3)) 146 #:env (current-module)) 147 #f) 148 (lambda (key whom what src form subform) 149 (list key whom what form subform)))) 150 151 (pass-if "set-fields" 152 (let ((s (make-foo (make-bar 1 2)))) 153 (and (equal? (set-field s (foo-x bar-j) 3) 154 (make-foo (make-bar 1 3))) 155 (equal? (set-fields s 156 ((foo-x bar-j) 3) 157 ((foo-z) 'bar)) 158 (let ((s2 (make-foo (make-bar 1 3)))) 159 (set-foo-z! s2 'bar) 160 s2)) 161 (equal? s (make-foo (make-bar 1 2)))))) 162 163 (pass-if-exception "set-fields on wrong struct type" exception:wrong-type-arg 164 (let ((s (make-bar (make-foo 5) 2))) 165 (set-fields 4 166 ((foo-x bar-j) 3) 167 ((foo-y) 'bar)))) 168 169 (pass-if-exception "set-fields on number" exception:wrong-type-arg 170 (set-fields 4 171 ((foo-x bar-j) 3) 172 ((foo-z) 'bar))) 173 174 (pass-if-equal "set-fields with unknown first getter" 175 '(syntax-error set-fields "unknown getter" 176 (set-fields s ((bar-i foo-x) 1) ((blah) 3)) 177 blah) 178 (catch 'syntax-error 179 (lambda () 180 (compile '(let ((s (make-bar (make-foo 5) 2))) 181 (set-fields s ((bar-i foo-x) 1) ((blah) 3))) 182 #:env (current-module)) 183 #f) 184 (lambda (key whom what src form subform) 185 (list key whom what form subform)))) 186 187 (pass-if-equal "set-fields with unknown second getter" 188 '(syntax-error set-fields "unknown getter" 189 (set-fields s ((bar-i foo-x) 1) ((blah) 3)) 190 blah) 191 (catch 'syntax-error 192 (lambda () 193 (compile '(let ((s (make-bar (make-foo 5) 2))) 194 (set-fields s ((bar-i foo-x) 1) ((blah) 3))) 195 #:env (current-module)) 196 #f) 197 (lambda (key whom what src form subform) 198 (list key whom what form subform)))) 199 200 (pass-if-equal "set-fields with duplicate field path" 201 '(syntax-error set-fields "duplicate field path" 202 (set-fields s 203 ((bar-i foo-x) 1) 204 ((bar-i foo-z) 2) 205 ((bar-i foo-x) 3)) 206 (bar-i foo-x)) 207 (catch 'syntax-error 208 (lambda () 209 (compile '(let ((s (make-bar (make-foo 5) 2))) 210 (set-fields s 211 ((bar-i foo-x) 1) 212 ((bar-i foo-z) 2) 213 ((bar-i foo-x) 3))) 214 #:env (current-module)) 215 #f) 216 (lambda (key whom what src form subform) 217 (list key whom what form subform)))) 218 219 (pass-if-equal "set-fields with one path as a prefix of another" 220 '(syntax-error set-fields 221 "one field path is a prefix of another" 222 (set-fields s 223 ((bar-i foo-x) 1) 224 ((bar-i foo-z) 2) 225 ((bar-i) 3)) 226 (bar-i)) 227 (catch 'syntax-error 228 (lambda () 229 (compile '(let ((s (make-bar (make-foo 5) 2))) 230 (set-fields s 231 ((bar-i foo-x) 1) 232 ((bar-i foo-z) 2) 233 ((bar-i) 3))) 234 #:env (current-module)) 235 #f) 236 (lambda (key whom what src form subform) 237 (list key whom what form subform))))) 238 239(with-test-prefix "side-effecting arguments" 240 241 (pass-if "predicate" 242 (let ((x 0)) 243 (and (foo? (begin (set! x (+ x 1)) f)) 244 (= x 1))))) 245 246(with-test-prefix "non-toplevel" 247 248 (define-record-type :frotz (make-frotz a b) frotz? 249 (a frotz-a) (b frotz-b set-frotz-b!)) 250 251 (pass-if "construction" 252 (let ((frotz (make-frotz 1 2))) 253 (and (= (frotz-a frotz) 1) 254 (= (frotz-b frotz) 2)))) 255 256 (with-test-prefix "functional setters" 257 (let () 258 (define-record-type foo (make-foo x) foo? 259 (x foo-x) 260 (y foo-y set-foo-y!) 261 (z foo-z set-foo-z!)) 262 263 (define-record-type :bar (make-bar i j) bar? 264 (i bar-i) 265 (j bar-j set-bar-j!)) 266 267 (pass-if "set-field" 268 (let ((s (make-foo (make-bar 1 2)))) 269 (and (equal? (set-field s (foo-x bar-j) 3) 270 (make-foo (make-bar 1 3))) 271 (equal? (set-field s (foo-z) 'bar) 272 (let ((s2 (make-foo (make-bar 1 2)))) 273 (set-foo-z! s2 'bar) 274 s2)) 275 (equal? s (make-foo (make-bar 1 2))))))) 276 277 (pass-if "set-fieldss " 278 279 (let ((s (make-foo (make-bar 1 2)))) 280 (and (equal? (set-field s (foo-x bar-j) 3) 281 (make-foo (make-bar 1 3))) 282 (equal? (set-fields s 283 ((foo-x bar-j) 3) 284 ((foo-z) 'bar)) 285 (let ((s2 (make-foo (make-bar 1 3)))) 286 (set-foo-z! s2 'bar) 287 s2)) 288 (equal? s (make-foo (make-bar 1 2)))))))) 289 290 291(define-immutable-record-type :baz 292 (make-baz x y z) 293 baz? 294 (x baz-x set-baz-x) 295 (y baz-y set-baz-y) 296 (z baz-z set-baz-z)) 297 298(define-immutable-record-type :address 299 (make-address street city country) 300 address? 301 (street address-street) 302 (city address-city) 303 (country address-country)) 304 305(define-immutable-record-type :person 306 (make-person age email address) 307 person? 308 (age person-age) 309 (email person-email) 310 (address person-address)) 311 312(with-test-prefix "define-immutable-record-type" 313 314 (pass-if "get" 315 (let ((b (make-baz 1 2 3))) 316 (and (= (baz-x b) 1) 317 (= (baz-y b) 2) 318 (= (baz-z b) 3)))) 319 320 (pass-if "get non-inlined" 321 (let ((b (make-baz 1 2 3))) 322 (equal? (map (cute apply <> (list b)) 323 (list baz-x baz-y baz-z)) 324 '(1 2 3)))) 325 326 (pass-if "set" 327 (let* ((b0 (make-baz 1 2 3)) 328 (b1 (set-baz-x b0 11)) 329 (b2 (set-baz-y b1 22)) 330 (b3 (set-baz-z b2 33))) 331 (and (= (baz-x b0) 1) 332 (= (baz-x b1) 11) (= (baz-x b2) 11) (= (baz-x b3) 11) 333 (= (baz-y b0) 2) (= (baz-y b1) 2) 334 (= (baz-y b2) 22) (= (baz-y b3) 22) 335 (= (baz-z b0) 3) (= (baz-z b1) 3) (= (baz-z b2) 3) 336 (= (baz-z b3) 33)))) 337 338 (pass-if "set non-inlined" 339 (let ((set (compose (cut set-baz-x <> 1) 340 (cut set-baz-y <> 2) 341 (cut set-baz-z <> 3)))) 342 (equal? (set (make-baz 0 0 0)) (make-baz 1 2 3)))) 343 344 (pass-if "set-field" 345 (let ((p (make-person 30 "foo@example.com" 346 (make-address "Foo" "Paris" "France")))) 347 (and (equal? (set-field p (person-address address-street) "Bar") 348 (make-person 30 "foo@example.com" 349 (make-address "Bar" "Paris" "France"))) 350 (equal? (set-field p (person-email) "bar@example.com") 351 (make-person 30 "bar@example.com" 352 (make-address "Foo" "Paris" "France"))) 353 (equal? p (make-person 30 "foo@example.com" 354 (make-address "Foo" "Paris" "France")))))) 355 356 (pass-if "set-fields" 357 (let ((p (make-person 30 "foo@example.com" 358 (make-address "Foo" "Paris" "France")))) 359 (and (equal? (set-fields p 360 ((person-email) "bar@example.com") 361 ((person-address address-country) "Catalonia") 362 ((person-address address-city) "Barcelona")) 363 (make-person 30 "bar@example.com" 364 (make-address "Foo" "Barcelona" "Catalonia"))) 365 (equal? (set-fields p 366 ((person-email) "bar@example.com") 367 ((person-age) 20)) 368 (make-person 20 "bar@example.com" 369 (make-address "Foo" "Paris" "France"))) 370 (equal? p (make-person 30 "foo@example.com" 371 (make-address "Foo" "Paris" "France")))))) 372 373 (with-test-prefix "non-toplevel" 374 375 (pass-if "get" 376 (let () 377 (define-immutable-record-type bar 378 (make-bar x y z) 379 bar? 380 (x bar-x) 381 (y bar-y) 382 (z bar-z set-bar-z)) 383 384 (let ((b (make-bar 1 2 3))) 385 (and (= (bar-x b) 1) 386 (= (bar-y b) 2) 387 (= (bar-z b) 3))))) 388 389 (pass-if "get non-inlined" 390 (let () 391 (define-immutable-record-type bar 392 (make-bar x y z) 393 bar? 394 (x bar-x) 395 (y bar-y) 396 (z bar-z set-bar-z)) 397 398 (let ((b (make-bar 1 2 3))) 399 (equal? (map (cute apply <> (list b)) 400 (list bar-x bar-y bar-z)) 401 '(1 2 3))))) 402 403 (pass-if "set" 404 (let () 405 (define-immutable-record-type bar 406 (make-bar x y z) 407 bar? 408 (x bar-x set-bar-x) 409 (y bar-y set-bar-y) 410 (z bar-z set-bar-z)) 411 412 (let* ((b0 (make-bar 1 2 3)) 413 (b1 (set-bar-x b0 11)) 414 (b2 (set-bar-y b1 22)) 415 (b3 (set-bar-z b2 33))) 416 (and (= (bar-x b0) 1) 417 (= (bar-x b1) 11) (= (bar-x b2) 11) (= (bar-x b3) 11) 418 (= (bar-y b0) 2) (= (bar-y b1) 2) 419 (= (bar-y b2) 22) (= (bar-y b3) 22) 420 (= (bar-z b0) 3) (= (bar-z b1) 3) (= (bar-z b2) 3) 421 (= (bar-z b3) 33))))) 422 423 (pass-if "set non-inlined" 424 (let () 425 (define-immutable-record-type bar 426 (make-bar x y z) 427 bar? 428 (x bar-x set-bar-x) 429 (y bar-y set-bar-y) 430 (z bar-z set-bar-z)) 431 432 (let ((set (compose (cut set-bar-x <> 1) 433 (cut set-bar-y <> 2) 434 (cut set-bar-z <> 3)))) 435 (equal? (set (make-bar 0 0 0)) (make-bar 1 2 3))))) 436 437 (pass-if "set-field" 438 (let () 439 (define-immutable-record-type address 440 (make-address street city country) 441 address? 442 (street address-street) 443 (city address-city) 444 (country address-country)) 445 446 (define-immutable-record-type :person 447 (make-person age email address) 448 person? 449 (age person-age) 450 (email person-email) 451 (address person-address)) 452 453 (let ((p (make-person 30 "foo@example.com" 454 (make-address "Foo" "Paris" "France")))) 455 (and (equal? (set-field p (person-address address-street) "Bar") 456 (make-person 30 "foo@example.com" 457 (make-address "Bar" "Paris" "France"))) 458 (equal? (set-field p (person-email) "bar@example.com") 459 (make-person 30 "bar@example.com" 460 (make-address "Foo" "Paris" "France"))) 461 (equal? p (make-person 30 "foo@example.com" 462 (make-address "Foo" "Paris" "France"))))))) 463 464 (pass-if "set-fields" 465 (let () 466 (define-immutable-record-type address 467 (make-address street city country) 468 address? 469 (street address-street) 470 (city address-city) 471 (country address-country)) 472 473 (define-immutable-record-type :person 474 (make-person age email address) 475 person? 476 (age person-age) 477 (email person-email) 478 (address person-address)) 479 480 (let ((p (make-person 30 "foo@example.com" 481 (make-address "Foo" "Paris" "France")))) 482 (and (equal? (set-fields p 483 ((person-email) "bar@example.com") 484 ((person-address address-country) "Catalonia") 485 ((person-address address-city) "Barcelona")) 486 (make-person 30 "bar@example.com" 487 (make-address "Foo" "Barcelona" "Catalonia"))) 488 (equal? (set-fields p 489 ((person-email) "bar@example.com") 490 ((person-age) 20)) 491 (make-person 20 "bar@example.com" 492 (make-address "Foo" "Paris" "France"))) 493 (equal? p (make-person 30 "foo@example.com" 494 (make-address "Foo" "Paris" "France"))))))) 495 496 (pass-if-equal "set-fields with unknown first getter" 497 '(syntax-error set-fields "unknown getter" 498 (set-fields s ((bar-i foo-x) 1) ((blah) 3)) 499 blah) 500 (catch 'syntax-error 501 (lambda () 502 (compile '(let () 503 (define-immutable-record-type foo 504 (make-foo x) 505 foo? 506 (x foo-x) 507 (y foo-y set-foo-y) 508 (z foo-z set-foo-z)) 509 510 (define-immutable-record-type :bar 511 (make-bar i j) 512 bar? 513 (i bar-i) 514 (j bar-j set-bar-j)) 515 516 (let ((s (make-bar (make-foo 5) 2))) 517 (set-fields s ((bar-i foo-x) 1) ((blah) 3)))) 518 #:env (current-module)) 519 #f) 520 (lambda (key whom what src form subform) 521 (list key whom what form subform)))) 522 523 (pass-if-equal "set-fields with unknown second getter" 524 '(syntax-error set-fields "unknown getter" 525 (set-fields s ((bar-i foo-x) 1) ((blah) 3)) 526 blah) 527 (catch 'syntax-error 528 (lambda () 529 (compile '(let () 530 (define-immutable-record-type foo 531 (make-foo x) 532 foo? 533 (x foo-x) 534 (y foo-y set-foo-y) 535 (z foo-z set-foo-z)) 536 537 (define-immutable-record-type :bar 538 (make-bar i j) 539 bar? 540 (i bar-i) 541 (j bar-j set-bar-j)) 542 543 (let ((s (make-bar (make-foo 5) 2))) 544 (set-fields s ((bar-i foo-x) 1) ((blah) 3)))) 545 #:env (current-module)) 546 #f) 547 (lambda (key whom what src form subform) 548 (list key whom what form subform)))) 549 550 (pass-if-equal "set-fields with duplicate field path" 551 '(syntax-error set-fields "duplicate field path" 552 (set-fields s 553 ((bar-i foo-x) 1) 554 ((bar-i foo-z) 2) 555 ((bar-i foo-x) 3)) 556 (bar-i foo-x)) 557 (catch 'syntax-error 558 (lambda () 559 (compile '(let () 560 (define-immutable-record-type foo 561 (make-foo x) 562 foo? 563 (x foo-x) 564 (y foo-y set-foo-y) 565 (z foo-z set-foo-z)) 566 567 (define-immutable-record-type :bar 568 (make-bar i j) 569 bar? 570 (i bar-i) 571 (j bar-j set-bar-j)) 572 573 (let ((s (make-bar (make-foo 5) 2))) 574 (set-fields s 575 ((bar-i foo-x) 1) 576 ((bar-i foo-z) 2) 577 ((bar-i foo-x) 3)))) 578 #:env (current-module)) 579 #f) 580 (lambda (key whom what src form subform) 581 (list key whom what form subform)))) 582 583 (pass-if-equal "set-fields with one path as a prefix of another" 584 '(syntax-error set-fields 585 "one field path is a prefix of another" 586 (set-fields s 587 ((bar-i foo-x) 1) 588 ((bar-i foo-z) 2) 589 ((bar-i) 3)) 590 (bar-i)) 591 (catch 'syntax-error 592 (lambda () 593 (compile '(let () 594 (define-immutable-record-type foo 595 (make-foo x) 596 foo? 597 (x foo-x) 598 (y foo-y set-foo-y) 599 (z foo-z set-foo-z)) 600 601 (define-immutable-record-type :bar 602 (make-bar i j) 603 bar? 604 (i bar-i) 605 (j bar-j set-bar-j)) 606 607 (let ((s (make-bar (make-foo 5) 2))) 608 (set-fields s 609 ((bar-i foo-x) 1) 610 ((bar-i foo-z) 2) 611 ((bar-i) 3)))) 612 #:env (current-module)) 613 #f) 614 (lambda (key whom what src form subform) 615 (list key whom what form subform)))) 616 617 (pass-if-equal "incompatible field paths" 618 '(syntax-error set-fields 619 "\ 620field paths (bar-i bar-j) and (bar-i foo-x) require one object \ 621to belong to two different record types (bar and foo)" 622 (set-fields s 623 ((bar-i foo-x) 1) 624 ((bar-i bar-j) 2) 625 ((bar-j) 3)) 626 #f) 627 (catch 'syntax-error 628 (lambda () 629 (compile '(let () 630 (define-immutable-record-type foo 631 (make-foo x) 632 foo? 633 (x foo-x) 634 (y foo-y set-foo-y) 635 (z foo-z set-foo-z)) 636 637 (define-immutable-record-type bar 638 (make-bar i j) 639 bar? 640 (i bar-i) 641 (j bar-j set-bar-j)) 642 643 (let ((s (make-bar (make-foo 5) 2))) 644 (set-fields s 645 ((bar-i foo-x) 1) 646 ((bar-i bar-j) 2) 647 ((bar-j) 3)))) 648 #:env (current-module)) 649 #f) 650 (lambda (key whom what src form subform) 651 (list key whom what form subform)))))) 652 653 654(with-test-prefix "record type definition error reporting" 655 656 (pass-if-equal "invalid type name" 657 '(syntax-error define-immutable-record-type 658 "expected type name" 659 (define-immutable-record-type 660 (foobar x y) 661 foobar? 662 (x foobar-x) 663 (y foobar-y)) 664 (foobar x y)) 665 (catch 'syntax-error 666 (lambda () 667 (compile '(define-immutable-record-type 668 (foobar x y) 669 foobar? 670 (x foobar-x) 671 (y foobar-y)) 672 #:env (current-module)) 673 #f) 674 (lambda (key whom what src form subform) 675 (list key whom what form subform)))) 676 677 (pass-if-equal "invalid constructor spec" 678 '(syntax-error define-immutable-record-type 679 "invalid constructor spec" 680 (define-immutable-record-type :foobar 681 (make-foobar x y 3) 682 foobar? 683 (x foobar-x) 684 (y foobar-y)) 685 (make-foobar x y 3)) 686 (catch 'syntax-error 687 (lambda () 688 (compile '(define-immutable-record-type :foobar 689 (make-foobar x y 3) 690 foobar? 691 (x foobar-x) 692 (y foobar-y)) 693 #:env (current-module)) 694 #f) 695 (lambda (key whom what src form subform) 696 (list key whom what form subform)))) 697 698 (pass-if-equal "invalid predicate name" 699 '(syntax-error define-immutable-record-type 700 "expected predicate name" 701 (define-immutable-record-type :foobar 702 (foobar x y) 703 (x foobar-x) 704 (y foobar-y)) 705 (x foobar-x)) 706 (catch 'syntax-error 707 (lambda () 708 (compile '(define-immutable-record-type :foobar 709 (foobar x y) 710 (x foobar-x) 711 (y foobar-y)) 712 #:env (current-module)) 713 #f) 714 (lambda (key whom what src form subform) 715 (list key whom what form subform)))) 716 717 (pass-if-equal "invalid field spec" 718 '(syntax-error define-record-type 719 "invalid field spec" 720 (define-record-type :foobar 721 (make-foobar x y) 722 foobar? 723 (x) 724 (y foobar-y)) 725 (x)) 726 (catch 'syntax-error 727 (lambda () 728 (compile '(define-record-type :foobar 729 (make-foobar x y) 730 foobar? 731 (x) 732 (y foobar-y)) 733 #:env (current-module)) 734 #f) 735 (lambda (key whom what src form subform) 736 (list key whom what form subform)))) 737 738 (pass-if-equal "unknown field in constructor spec" 739 '(syntax-error define-record-type 740 "unknown field in constructor spec" 741 (define-record-type :foobar 742 (make-foobar x z) 743 foobar? 744 (x foobar-x) 745 (y foobar-y)) 746 z) 747 (catch 'syntax-error 748 (lambda () 749 (compile '(define-record-type :foobar 750 (make-foobar x z) 751 foobar? 752 (x foobar-x) 753 (y foobar-y)) 754 #:env (current-module)) 755 #f) 756 (lambda (key whom what src form subform) 757 (list key whom what form subform))))) 758 759(with-test-prefix "record compatibility" 760 761 (pass-if "record?" 762 (record? (make-foo 1))) 763 764 (pass-if "record-constructor" 765 (equal? ((record-constructor :foo) 1) 766 (make-foo 1)))) 767 768;;; Local Variables: 769;;; mode: scheme 770;;; eval: (put 'set-fields 'scheme-indent-function 1) 771;;; End: 772