X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/6774820f1e83a388b3232cd61a66340886b395d8..f2c3d29fd256ff4b6022d9af98543be7c625422e:/test-suite/tests/srfi-35.test diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test index ec7a104c3..5e4cb271e 100644 --- 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 +;;;; srfi-35.test --- SRFI-35. -*- mode: scheme; coding: utf-8; -*- +;;;; Ludovic Courtès ;;;; -;;;; 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)) +(with-test-prefix "cond-expand" + (pass-if "srfi-35" + (cond-expand (srfi-35 #t) + (else #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))))) @@ -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"))) -