mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-12 16:50:22 +02:00
Code Activity

Use test-file-name' and data-file-name'

Browse source 
instead of `data-file'.
This commit is contained in:
Thien-Thi Nguyen 2002-02-09 23:12:46 +00:00
parent 5570bfb40d
commit 9c93b34cc2
1 changed files with 11 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

22
test-suite/tests/r4rs.test
View file

@ -1,16 +1,16 @@
;;;; r4rs.test --- tests for R4RS compliance -*- scheme -*- ;;;; r4rs.test --- tests for R4RS compliance -*- scheme -*-
;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999 Free Software Foundation, Inc. ;;;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1999 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This program is free software; you can redistribute it and/or modify ;;;; 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 ;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version. ;;;; any later version.
;;;; ;;;;
;;;; This program is distributed in the hope that it will be useful, ;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details. ;;;; GNU General Public License for more details.
;;;; ;;;;
;;;; You should have received a copy of the GNU General Public License ;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to ;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@ -38,7 +38,7 @@
;;;; ;;;;
;;;; If you write modifications of your own for GUILE, it is your choice ;;;; If you write modifications of your own for GUILE, it is your choice
;;;; whether to permit this exception to apply to your modifications. ;;;; whether to permit this exception to apply to your modifications.
;;;; If you do not wish that, delete this exception notice. ;;;; If you do not wish that, delete this exception notice.
;;;; ============= NOTE ============= ;;;; ============= NOTE =============
@ -75,9 +75,9 @@
;;; There are three optional tests: ;;; There are three optional tests:
;;; (TEST-CONT) tests multiple returns from call-with-current-continuation ;;; (TEST-CONT) tests multiple returns from call-with-current-continuation
;;; ;;;
;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE ;;; (TEST-SC4) tests procedures required by R4RS but not by IEEE
;;; ;;;
;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by ;;; (TEST-DELAY) tests DELAY and FORCE, which are not required by
;;; either standard. ;;; either standard.
@ -235,7 +235,7 @@
`((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons)))) `((foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))))
;;; sqt is defined here because not all implementations are required to ;;; sqt is defined here because not all implementations are required to
;;; support it. ;;; support it.
(define (sqt x) (define (sqt x)
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((> (* i i) x) (- i 1)))) ((> (* i i) x) (- i 1))))
@ -873,7 +873,7 @@
;;; other than escape procedures. I am indebted to ;;; other than escape procedures. I am indebted to
;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this ;;; raja@copper.ucs.indiana.edu (Raja Sooriamurthi) for fixing this
;;; code. The function leaf-eq? compares the leaves of 2 arbitrary ;;; code. The function leaf-eq? compares the leaves of 2 arbitrary
;;; trees constructed of conses. ;;; trees constructed of conses.
(define (next-leaf-generator obj eot) (define (next-leaf-generator obj eot)
(letrec ((return #f) (letrec ((return #f)
(cont (lambda (x) (cont (lambda (x)
@ -935,8 +935,8 @@
(SECTION 6 10 1) (SECTION 6 10 1)
(test #t input-port? (current-input-port)) (test #t input-port? (current-input-port))
(test #t output-port? (current-output-port)) (test #t output-port? (current-output-port))
(test #t call-with-input-file (data-file "tests/r4rs.test") input-port?) (test #t call-with-input-file (test-file-name "r4rs.test") input-port?)
(define this-file (open-input-file (data-file "tests/r4rs.test"))) (define this-file (open-input-file (test-file-name "r4rs.test")))
(test #t input-port? this-file) (test #t input-port? this-file)
(SECTION 6 10 2) (SECTION 6 10 2)
(test #\; peek-char this-file) (test #\; peek-char this-file)
@ -997,7 +997,7 @@
(test '#(dididit dah) list->vector '(dididit dah)) (test '#(dididit dah) list->vector '(dididit dah))
(test '#() list->vector '()) (test '#() list->vector '())
(SECTION 6 10 4) (SECTION 6 10 4)
(load (data-file "tmp1")) (load (data-file-name "tmp1"))
(test write-test-obj 'load foo) (test write-test-obj 'load foo)
(report-errs)) (report-errs))