source: project/release/4/csv-xml/trunk/tests/run.scm @ 34889

Last change on this file since 34889 was 34889, checked in by Kon Lovett, 4 years ago

fix quoting when sep char , fix quoting when # or ???

File size: 3.8 KB
Line 
1;;;; csv-xml-test.scm  -*- Hen -*-
2
3(use csv-xml)
4
5;;;
6
7;Need to process `#lang' as well. So just "commented out" the "offending"
8;sections in the source.
9#;(define-syntax require (syntax-rules () ((_ ?x0 ...) (begin))))
10
11(use testeez)
12(include "test-csv.ss")
13
14;;;
15
16(newline)
17
18(use test)
19
20;;
21
22(test-begin "csv-xml in")
23
24(define +reader-spec-default+ '(
25  (newline-type . lax)
26  (separator-chars #\,)
27  (quote-char . #\")
28  (quote-doubling-escapes? . #t)
29  (comment-chars)
30  (whitespace-chars #\space)
31  (strip-leading-whitespace? . #f)
32  (strip-trailing-whitespace? . #f)
33  (newlines-in-quotes? . #t)
34))
35
36(test "reader-spec defaults"
37  +reader-spec-default+ (reader-spec))
38
39(define +reader-spec-default-2+ '(
40  (newline-type . lax)
41  (separator-chars #\,)
42  (quote-char . #\")
43  (quote-doubling-escapes? . #f)
44  (comment-chars)
45  (whitespace-chars #\space)
46  (strip-leading-whitespace? . #f)
47  (strip-trailing-whitespace? . #f)
48  (newlines-in-quotes? . #t)
49))
50
51(test "reader-spec overrides"
52  +reader-spec-default-2+ (reader-spec #:quote-doubling-escapes? #f))
53
54(test-end "csv-xml in")
55
56;;
57
58(test-begin "csv-xml out")
59
60;
61
62(define +writer-spec-default+ '(
63  (newline-char . #t)
64  (separator-char . #\,)
65  (quote-char . #\")
66  (comment-char . #\#)
67  (quote-doubling-escapes? . #t)
68  (quote-controls? . #t)
69  (always-quote? . #t)
70))
71
72(define +writer-spec-default-2+ '(
73  (newline-char . #f)
74  (separator-char . #\,)
75  (quote-char . #\")
76  (comment-char . #\#)
77  (quote-doubling-escapes? . #t)
78  (quote-controls? . #t)
79  (always-quote? . #t)
80))
81
82;
83
84(test "writer-spec defaults" +writer-spec-default+ (writer-spec))
85
86(test "writer-spec overrides" +writer-spec-default-2+ (writer-spec #:newline-char #f))
87
88;
89
90(define +list-in-1+ '((1 22 333) (11 2222 333333)))
91
92(define +list-in-2+ '((1 22 333) "a comment" (11 2222 333333)))
93
94#|
95(define +list->sxml-out-1+ '(
96  *TOP*
97  (scull
98    (foo "1")
99    (bar "22")
100    (baz "333"))
101  (scull
102    (foo "11")
103    (bar "2222")
104    (baz "333333"))
105))
106
107(define +list->sxml-out-2+ '(
108  *TOP*
109  (scull
110    (foo "1")
111    (bar "22")
112    (baz "333"))
113  (*COMMENT* "a comment")
114  (scull
115    (foo "11")
116    (bar "2222")
117    (baz "333333"))
118))
119
120;
121
122(test "sxml"
123  +list->sxml-out-1+ (list->sxml +list-in-1+ 'scull '(foo bar baz)))
124
125(test "sxml & comment w/ comments"
126  +list->sxml-out-2+ (list->sxml +list-in-2+ 'scull '(foo bar baz)))
127|#
128
129;
130
131(use ports)
132
133(test "csv"
134  "\"1\",\"22\",\"333\"\n\"11\",\"2222\",\"333333\"\n"
135  (with-output-to-string
136    (lambda ()
137      (list->csv +list-in-1+))))
138
139(test "csv & comment w/ comments"
140  "\"1\",\"22\",\"333\"\n#a comment\n\"11\",\"2222\",\"333333\"\n"
141  (with-output-to-string
142    (lambda ()
143      (let ((writer
144              (make-csv-writer
145                (current-output-port)
146                (writer-spec #:comment-char #\#))))
147        ;(test-assert (procedure? writer))
148        (list->csv +list-in-2+ writer)))))
149
150(test "csv & comment w/o comments"
151  "\"1\",\"22\",\"333\"\na comment\"11\",\"2222\",\"333333\"\n"
152  (with-output-to-string
153    (lambda ()
154      (let ((writer
155              (make-csv-writer
156                (current-output-port)
157                (writer-spec #:comment-char #f))))
158        ;(test-assert (procedure? writer))
159        (list->csv +list-in-2+ writer)))))
160
161(test-end "csv-xml out")
162
163;;
164
165(use extras)
166
167(define (read-csv string delimiter)
168  (csv->list (make-csv-reader string `((separator-chars ,delimiter)))))
169
170(define (write-csv rows delimiter)
171  (call-with-output-string
172   (lambda (out)
173     (let ((writer (writer-spec separator-char: delimiter always-quote?: #f)))
174       (list->csv rows (make-csv-writer out writer))))))
175
176(define rows '(("f\"o\"o" "1") ("b,a,r" "2") ("b'a'z" "3")))
177
178(let* ((delimiter #\,)
179       (csv (write-csv rows delimiter)))
180  (printf "Serialized form (always-quote?: #f):\n~a\n" csv)
181  (let ((result (read-csv csv delimiter)))
182    (test "Roundtrip" rows result) ) )
183
184;;
185
186(test-exit)
Note: See TracBrowser for help on using the repository browser.