;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-10
;;;;
-;;;; Copyright (C) 2001, 2006, 2007, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2007, 2010, 2011, 2012,
+;;;; 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(define b (make-bar 123 456))
+(define exception:syntax-error-wrong-num-args
+ (cons 'syntax-error "Wrong number of arguments"))
+
(with-test-prefix "constructor"
;; Constructors are defined using `define-integrable', meaning that direct
;; calls as in `(make-foo)' lead to a compile-time psyntax error, hence the
;; distinction below.
- (pass-if-exception "foo 0 args (inline)" exception:syntax-pattern-unmatched
+ (pass-if-exception "foo 0 args (inline)" exception:syntax-error-wrong-num-args
(compile '(make-foo) #:env (current-module)))
- (pass-if-exception "foo 2 args (inline)" exception:syntax-pattern-unmatched
+ (pass-if-exception "foo 2 args (inline)" exception:syntax-error-wrong-num-args
(compile '(make-foo 1 2) #:env (current-module)))
(pass-if-exception "foo 0 args" exception:wrong-num-args
(pass-if "set-field"
(let ((s (make-foo (make-bar 1 2))))
- (and (equal? (set-field (foo-x bar-j) s 3)
+ (and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
- (equal? (set-field (foo-z) s 'bar)
+ (equal? (set-field s (foo-z) 'bar)
(let ((s2 (make-foo (make-bar 1 2))))
(set-foo-z! s2 'bar)
s2))
(pass-if-exception "set-field on wrong struct type" exception:wrong-type-arg
(let ((s (make-bar (make-foo 5) 2)))
- (set-field (foo-x bar-j) s 3)))
+ (set-field s (foo-x bar-j) 3)))
(pass-if-exception "set-field on number" exception:wrong-type-arg
- (set-field (foo-x bar-j) 4 3))
+ (set-field 4 (foo-x bar-j) 3))
(pass-if-equal "set-field with unknown first getter"
'(syntax-error set-fields "unknown getter"
- (set-field (blah) s 3)
+ (set-field s (blah) 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
- (set-field (blah) s 3))
+ (set-field s (blah) 3))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(pass-if-equal "set-field with unknown second getter"
'(syntax-error set-fields "unknown getter"
- (set-field (bar-j blah) s 3)
+ (set-field s (bar-j blah) 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
- (set-field (bar-j blah) s 3))
+ (set-field s (bar-j blah) 3))
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(pass-if "set-fields"
(let ((s (make-foo (make-bar 1 2))))
- (and (equal? (set-field (foo-x bar-j) s 3)
+ (and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-fields s
((foo-x bar-j) 3)
(pass-if "set-field"
(let ((s (make-foo (make-bar 1 2))))
- (and (equal? (set-field (foo-x bar-j) s 3)
+ (and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
- (equal? (set-field (foo-z) s 'bar)
+ (equal? (set-field s (foo-z) 'bar)
(let ((s2 (make-foo (make-bar 1 2))))
(set-foo-z! s2 'bar)
s2))
(equal? s (make-foo (make-bar 1 2)))))))
- (pass-if "set-fields"
+ (pass-if "set-fieldss "
(let ((s (make-foo (make-bar 1 2))))
- (and (equal? (set-field (foo-x bar-j) s 3)
+ (and (equal? (set-field s (foo-x bar-j) 3)
(make-foo (make-bar 1 3)))
(equal? (set-fields s
((foo-x bar-j) 3)
(pass-if "set-field"
(let ((p (make-person 30 "foo@example.com"
(make-address "Foo" "Paris" "France"))))
- (and (equal? (set-field (person-address address-street) p "Bar")
+ (and (equal? (set-field p (person-address address-street) "Bar")
(make-person 30 "foo@example.com"
(make-address "Bar" "Paris" "France")))
- (equal? (set-field (person-email) p "bar@example.com")
+ (equal? (set-field p (person-email) "bar@example.com")
(make-person 30 "bar@example.com"
(make-address "Foo" "Paris" "France")))
(equal? p (make-person 30 "foo@example.com"
(let ((p (make-person 30 "foo@example.com"
(make-address "Foo" "Paris" "France"))))
- (and (equal? (set-field (person-address address-street) p "Bar")
+ (and (equal? (set-field p (person-address address-street) "Bar")
(make-person 30 "foo@example.com"
(make-address "Bar" "Paris" "France")))
- (equal? (set-field (person-email) p "bar@example.com")
+ (equal? (set-field p (person-email) "bar@example.com")
(make-person 30 "bar@example.com"
(make-address "Foo" "Paris" "France")))
(equal? p (make-person 30 "foo@example.com"
((bar-i) 3))))
#:env (current-module))
#f)
+ (lambda (key whom what src form subform)
+ (list key whom what form subform))))
+
+ (pass-if-equal "incompatible field paths"
+ '(syntax-error set-fields
+ "\
+field paths (bar-i bar-j) and (bar-i foo-x) require one object \
+to belong to two different record types (bar and foo)"
+ (set-fields s
+ ((bar-i foo-x) 1)
+ ((bar-i bar-j) 2)
+ ((bar-j) 3))
+ #f)
+ (catch 'syntax-error
+ (lambda ()
+ (compile '(let ()
+ (define-immutable-record-type foo
+ (make-foo x)
+ foo?
+ (x foo-x)
+ (y foo-y set-foo-y)
+ (z foo-z set-foo-z))
+
+ (define-immutable-record-type bar
+ (make-bar i j)
+ bar?
+ (i bar-i)
+ (j bar-j set-bar-j))
+
+ (let ((s (make-bar (make-foo 5) 2)))
+ (set-fields s
+ ((bar-i foo-x) 1)
+ ((bar-i bar-j) 2)
+ ((bar-j) 3))))
+ #:env (current-module))
+ #f)
(lambda (key whom what src form subform)
(list key whom what form subform))))))
HCoop / bpt / guile.git / blobdiff