1 ;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*-
2 ;;;; Martin Grabmueller, 2001-05-10
4 ;;;; Copyright (C) 2001, 2006, 2007, 2010, 2011 Free Software Foundation, Inc.
6 ;;;; This library is free software; you can redistribute it and/or
7 ;;;; modify it under the terms of the GNU Lesser General Public
8 ;;;; License as published by the Free Software Foundation; either
9 ;;;; version 3 of the License, or (at your option) any later version.
11 ;;;; This library is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 ;;;; Lesser General Public License for more details.
16 ;;;; You should have received a copy of the GNU Lesser General Public
17 ;;;; License along with this library; if not, write to the Free Software
18 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-suite test-numbers)
21 #:use-module (test-suite lib)
22 #:use-module ((system base compile) #:select (compile))
23 #:use-module (srfi srfi-9))
26 (define-record-type :qux (make-qux) qux?)
28 (define-record-type :foo (make-foo x) foo?
29 (x get-x) (y get-y set-y!))
31 (define-record-type :bar (make-bar i j) bar?
32 (i get-i) (i get-j set-j!))
34 (define f (make-foo 1))
37 (define b (make-bar 123 456))
39 (with-test-prefix "constructor"
41 ;; Constructors are defined using `define-integrable', meaning that direct
42 ;; calls as in `(make-foo)' lead to a compile-time psyntax error, hence the
45 (pass-if-exception "foo 0 args (inline)" exception:syntax-pattern-unmatched
46 (compile '(make-foo) #:env (current-module)))
47 (pass-if-exception "foo 2 args (inline)" exception:syntax-pattern-unmatched
48 (compile '(make-foo 1 2) #:env (current-module)))
50 (pass-if-exception "foo 0 args" exception:wrong-num-args
51 (let ((make-foo make-foo))
53 (pass-if-exception "foo 2 args" exception:wrong-num-args
54 (let ((make-foo make-foo))
57 (with-test-prefix "predicate"
61 (pass-if "fail wrong record type"
63 (pass-if "fail number"
66 (with-test-prefix "accessor"
73 (pass-if-exception "get-x on number" exception:wrong-type-arg
75 (pass-if-exception "get-y on number" exception:wrong-type-arg
78 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
79 (pass-if-exception "get-x on bar" exception:wrong-type-arg
81 (pass-if-exception "get-y on bar" exception:wrong-type-arg
84 (with-test-prefix "modifier"
90 (pass-if-exception "set-y! on number" exception:wrong-type-arg
93 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
94 (pass-if-exception "set-y! on bar" exception:wrong-type-arg
97 (with-test-prefix "non-toplevel"
99 (define-record-type :frotz (make-frotz a b) frotz?
100 (a frotz-a) (b frotz-b set-frotz-b!))
102 (pass-if "construction"
103 (let ((frotz (make-frotz 1 2)))
104 (and (= (frotz-a frotz) 1)
105 (= (frotz-b frotz) 2)))))