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 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 (srfi srfi-9))
25 (define-record-type :foo (make-foo x) foo?
26 (x get-x) (y get-y set-y!))
28 (define-record-type :bar (make-bar i j) bar?
29 (i get-i) (i get-j set-j!))
31 (define f (make-foo 1))
34 (define b (make-bar 123 456))
36 (with-test-prefix "constructor"
38 (pass-if-exception "foo 0 args" exception:wrong-num-args
40 (pass-if-exception "foo 2 args" exception:wrong-num-args
43 (with-test-prefix "predicate"
47 (pass-if "fail wrong record type"
49 (pass-if "fail number"
52 (with-test-prefix "accessor"
59 (pass-if-exception "get-x on number" exception:wrong-type-arg
61 (pass-if-exception "get-y on number" exception:wrong-type-arg
64 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
65 (pass-if-exception "get-x on bar" exception:wrong-type-arg
67 (pass-if-exception "get-y on bar" exception:wrong-type-arg
70 (with-test-prefix "modifier"
76 (pass-if-exception "set-y! on number" exception:wrong-type-arg
79 ;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
80 (pass-if-exception "set-y! on bar" exception:wrong-type-arg