← Back to branch summary

~ubuntu-branches/ubuntu/hardy/sigscheme/hardy-proposed

« back to all changes in this revision

Viewing changes to test/test-srfi6.scm

  • Committer: Bazaar Package Importer
  • Author(s): NIIBE Yutaka
  • Date: 2007-01-29 15:31:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070129153124-j5fcqyrwcfbczma7
Tags: 0.7.4-1
New upstream release.

Show diffs side-by-side

added added

removed removed

Lines of Context:
test/test-srfi6.scm
1
 
;;  Filename : test-exp.scm
2
 
;;  About    : unit test for R5RS expressions
 
1
;;  Filename : test-srfi6.scm
 
2
;;  About    : unit test for SRFI-6 Basic String Ports
3
3
;;
4
4
;;  Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp>
 
5
;;  Copyright (c) 2007 SigScheme Project <uim AT freedesktop.org>
5
6
;;
6
7
;;  All rights reserved.
7
8
;;
34
35
 
35
36
(use srfi-6)
36
37
 
37
 
 
 
38
(if (not (provided? "srfi-6"))
 
39
    (test-skip "SRFI-6 is not enabled"))
 
40
 
 
41
(define tn test-name)
 
42
 
 
43
;;
38
44
;; open-input-string
39
 
;;;; immutable
 
45
;;
 
46
 
 
47
(tn "open-input-string invalid forms")
 
48
(assert-error  (tn) (lambda () (open-input-string)))
 
49
(assert-error  (tn) (lambda () (open-input-string '())))
 
50
(assert-error  (tn) (lambda () (open-input-string (current-input-port))))
 
51
(assert-error  (tn) (lambda () (open-input-string "" "")))
 
52
 
 
53
;; immutable
40
54
(define p
41
55
  (open-input-string "(a . (b . (c . ()))) 34"))
42
56
 
43
 
(assert-true   "open-input-string immutable" (input-port? p))
44
 
(assert-equal? "open-input-string immutable" '(a b c) (read p))
45
 
(assert-equal? "open-input-string immutable" 34 (read p))
46
 
;;;; mutable
 
57
(tn "open-input-string immutable")
 
58
(assert-true   (tn) (input-port? p))
 
59
(assert-equal? (tn) '(a b c) (read p))
 
60
(assert-equal? (tn) 34 (read p))
 
61
(assert-true   (tn) (eof-object? (read p)))
 
62
(assert-true   (tn) (eof-object? (read-char (open-input-string ""))))
 
63
 
 
64
;; mutable
47
65
(define p2
48
66
  (open-input-string (string-copy "(a . (b . (c . ()))) 34")))
49
67
 
50
 
(assert-true   "open-input-string mutable" (input-port? p2))
51
 
(assert-equal? "open-input-string mutable" '(a b c) (read p2))
52
 
(assert-equal? "open-input-string mutable" 34 (read p2))
 
68
(tn "open-input-string mutable")
 
69
(assert-true   (tn) (input-port? p2))
 
70
(assert-equal? (tn) '(a b c) (read p2))
 
71
(assert-equal? (tn) 34 (read p2))
 
72
(assert-true   (tn) (eof-object? (read p2)))
 
73
(assert-true   (tn) (eof-object? (read-char
 
74
                                  (open-input-string (string-copy "")))))
53
75
 
 
76
;;
54
77
;; open-output-string and get-output-string
55
 
(assert-equal? "output string test 1" "a(b c)" (let ((q (open-output-string))
56
 
                                                     (x '(a b c)))
57
 
                                                 (write (car x) q)
58
 
                                                 (write (cdr x) q)
59
 
                                                 (get-output-string q)))
60
 
(assert-equal? "output string test 2" "" (get-output-string
61
 
                                          (open-output-string)))
 
78
;;
 
79
 
 
80
(tn "open-output-string invalid forms")
 
81
(assert-error  (tn) (lambda () (open-output-string '())))
 
82
(assert-error  (tn) (lambda () (open-output-string (current-input-port))))
 
83
(assert-error  (tn) (lambda () (open-output-string "")))
 
84
 
 
85
(tn "get-output-string invalid forms")
 
86
(assert-error  (tn) (lambda () (get-output-string)))
 
87
(assert-error  (tn) (lambda () (get-output-string (current-output-port))))
 
88
 
 
89
(tn "output string")
 
90
(assert-equal? (tn)
 
91
               "a(b c)"
 
92
               (let ((q (open-output-string))
 
93
                     (x '(a b c)))
 
94
                 (write (car x) q)
 
95
                 (write (cdr x) q)
 
96
                 (get-output-string q)))
 
97
(assert-equal? (tn)
 
98
               "aB"
 
99
               (let ((q (open-output-string)))
 
100
                 (write-char #\a q)
 
101
                 (write-char #\B q)
 
102
                 (get-output-string q)))
 
103
(assert-equal? (tn)
 
104
               ""
 
105
               (get-output-string (open-output-string)))
62
106
 
63
107
(total-report)