tests: Check 'simple-format' with closed current-output-port.

[bpt/guile.git] / test-suite / tests / srfi-35.test

diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test
index ec7a104..5e4cb27 100644 (file)
--- a/test-suite/tests/srfi-35.test
+++ b/test-suite/tests/srfi-35.test
@@ -1,34 +1,43 @@
-;;;; srfi-35.test --- Test suite for SRFI-35               -*- Scheme -*-
-;;;; Ludovic Courtès <ludo@gnu.org>
+;;;; srfi-35.test --- SRFI-35.             -*- mode: scheme; coding: utf-8; -*-
+;;;; Ludovic Courtès <ludo@gnu.org>
 ;;;;
-;;;;   Copyright (C) 2007 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 ;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;; 
+;;;; This library is distributed in the hope that it will be useful,
 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING.  If not, write to
-;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;;;; Boston, MA 02110-1301 USA
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;; 
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-srfi-35)
   :use-module (test-suite lib)
   :use-module (srfi srfi-35))
 
 \f
+(with-test-prefix "cond-expand"
+  (pass-if "srfi-35"
+    (cond-expand (srfi-35 #t)
+                 (else    #f))))
+
+\f
 (with-test-prefix "condition types"
   (pass-if "&condition"
     (condition-type? &condition))
 
   (pass-if "make-condition-type"
-    (condition-type? (make-condition-type 'foo &condition '(a b)))))
+    (condition-type? (make-condition-type 'foo &condition '(a b))))
+
+  (pass-if "struct-vtable-name"
+    (let ((ct  (make-condition-type 'chbouib &condition '(a b))))
+      (eq? 'chbouib (struct-vtable-name ct)))))
 
 
 \f
@@ -56,17 +65,17 @@
   (pass-if "condition-ref"
     (let* ((ct (make-condition-type 'chbouib &condition '(a b)))
            (c  (make-condition ct 'b 1 'a 0)))
-      (and (eq? (condition-ref c 'a) 0)
-           (eq? (condition-ref c 'b) 1))))
+      (and (eqv? (condition-ref c 'a) 0)
+           (eqv? (condition-ref c 'b) 1))))
 
   (pass-if "condition-ref with inheritance"
     (let* ((top (make-condition-type 'foo &condition '(a b)))
            (ct  (make-condition-type 'bar top '(c d)))
            (c   (make-condition ct 'b 1 'a 0 'd 3 'c 2)))
-      (and (eq? (condition-ref c 'a) 0)
-           (eq? (condition-ref c 'b) 1)
-           (eq? (condition-ref c 'c) 2)
-           (eq? (condition-ref c 'd) 3))))
+      (and (eqv? (condition-ref c 'a) 0)
+           (eqv? (condition-ref c 'b) 1)
+           (eqv? (condition-ref c 'c) 2)
+           (eqv? (condition-ref c 'd) 3))))
 
   (pass-if "extract-condition"
     (let* ((ct (make-condition-type 'chbouib &condition '(a b)))
@@ -140,8 +149,8 @@
                   (let ((c (make-condition &chbouib 'one 1 'two 2)))
                     (and (condition? c)
                          (chbouib? c)
-                         (eq? (chbouib-one c) 1)
-                         (eq? (chbouib-two c) 2))))
+                         (eqv? (chbouib-one c) 1)
+                         (eqv? (chbouib-two c) 2))))
             m)))
 
   (pass-if "condition"
@@ -307,4 +316,3 @@
 
   (pass-if "(c2-b v5)"
     (equal? (c2-b v5) "b2")))
-