1 ;;;; records.test --- Test suite for Guile's records. -*- mode: scheme; coding: utf-8 -*-
3 ;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
5 ;;;; This library is free software; you can redistribute it and/or
6 ;;;; modify it under the terms of the GNU Lesser General Public
7 ;;;; License as published by the Free Software Foundation; either
8 ;;;; version 3 of the License, or (at your option) any later version.
10 ;;;; This library is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;;;; Lesser General Public License for more details.
15 ;;;; You should have received a copy of the GNU Lesser General Public
16 ;;;; License along with this library; if not, write to the Free Software
17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
19 (define-module (test-records)
20 #:use-module (ice-9 format)
21 #:use-module (test-suite lib))
23 ;; ascii names and symbols, custom printer
24 (define rtd-foo (make-record-type "foo" '(x y)
26 (display "#<it is a foo>" p))))
27 (define make-foo (record-constructor rtd-foo))
28 (define foo? (record-predicate rtd-foo))
29 (define get-foo-x (record-accessor rtd-foo 'x))
30 (define get-foo-y (record-accessor rtd-foo 'y))
31 (define set-foo-x! (record-modifier rtd-foo 'x))
32 (define set-foo-y! (record-modifier rtd-foo 'y))
34 ;; non-Latin-1 names and symbols, default printer
35 (define rtd-fŏŏ (make-record-type "fŏŏ" '(x ȳ)))
36 (define make-fŏŏ (record-constructor rtd-fŏŏ))
37 (define fŏŏ? (record-predicate rtd-fŏŏ))
38 (define get-fŏŏ-x (record-accessor rtd-fŏŏ 'x))
39 (define get-fŏŏ-ȳ (record-accessor rtd-fŏŏ 'ȳ))
40 (define set-fŏŏ-x! (record-modifier rtd-fŏŏ 'x))
41 (define set-fŏŏ-ȳ! (record-modifier rtd-fŏŏ 'ȳ))
43 (with-test-prefix "records"
45 (with-test-prefix "constructor"
47 (pass-if-exception "0 args (2 required)" exception:wrong-num-args
50 (pass-if-exception "1 arg (2 required)" exception:wrong-num-args
53 (pass-if "2 args (2 required)" exception:wrong-num-args
54 (foo? (make-foo 1 2)))
56 (pass-if "non-latin-1" exception:wrong-num-args
57 (fŏŏ? (make-fŏŏ 1 2))))
59 (with-test-prefix "modifier and getter"
62 (let ((r (make-foo 1 2)))
64 (eqv? (get-foo-x r) 3)))
67 (let ((r (make-fŏŏ 1 2)))
69 (eqv? (get-fŏŏ-ȳ r) 3))))
71 (with-test-prefix "record type name"
74 (string=? "foo" (record-type-name rtd-foo)))
77 (string=? "fŏŏ" (record-type-name rtd-fŏŏ))))
79 (with-test-prefix "printer"
82 (string=? "#<it is a foo>"
83 (with-output-to-string
84 (lambda () (display (make-foo 1 2))))))
87 (with-locale "en_US.utf8"
88 (string-prefix? "#<fŏŏ"
89 (with-output-to-string
90 (lambda () (display (make-fŏŏ 1 2)))))))))