root/lang/gauche/oldtype/trunk/src/test.scm @ 16055

Revision 16055, 7.4 kB (checked in by kiyoka, 6 years ago)
Line 
1;; -*- coding: utf-8 -*-
2(use srfi-1)
3(use sxml.tools)
4(use sxml.serializer)
5(use text.html-lite)
6(use text.tree)
7(use gauche.charconv)
8(use oldtype.parse)
9(use oldtype.format)
10(use oldtype.util)
11(use oldtype.log)
12(use oldtype.timeline)
13(use oldtype.page)
14(use oldtype.core)
15(use oldtype.svn)
16(use gauche.test)                                                     
17(use util.list)
18
19
20;; Main -------------------------------------------------------
21(define (main args)
22  (let* (
23         (_ (cdr args))
24         (input-file (first _))
25         (log-file   (second _))
26         (ann-file   (third _))
27         (converted-str
28          (port->string
29           (open-input-conversion-port
30            (open-input-file input-file)
31            "*JP")))
32
33         ;; Making string port from stdin/file
34         ;;
35         (input-port
36          (open-input-string converted-str)))
37    (let ((oldtype-page #f)
38          (oldtype-page-no-timeline #f)
39          (oldtype-timeline #f)
40          (loaded
41           (with-input-from-file "Test.sexp.master"
42             (lambda ()
43               (read))))
44          (loaded-no-timeline
45           (with-input-from-file "Test.no-timeline.sexp.master"
46             (lambda ()
47               (read)))))
48      (test-start "serialize,deserialize")
49
50      (test-section "oldtype-timeline")
51      (let1 oldtype-timeline
52            (parse (make <oldtype-timeline> :name "Test") log-file ann-file)
53            (let* ((serialized     (serialize oldtype-timeline))
54                   (deserialized   (deserialize (make <oldtype-timeline>) serialized)))
55              (test "serialized == DATA        "
56                    (assq-ref loaded 'timeline)
57                    (lambda () (serialize deserialized)))
58              (test "serialized == deserialized" serialized (lambda () (serialize deserialized)))))
59
60      (test-section "oldtype-page")
61      (set! oldtype-page
62            (parse (make <oldtype-page> :name "Test") input-port log-file ann-file))
63      (port-seek input-port 0)
64      (set! oldtype-page-no-timeline
65            (parse (make <oldtype-page> :name "Test") input-port #f #f))
66
67      (let1 serialized     (serialize oldtype-page)
68            (test "serialized == DATA (1)  "
69                  loaded
70                  (lambda () (serialize oldtype-page)))
71           
72            (test "serialized == deserialized" serialized (lambda ()
73                                                            (serialize
74                                                             (deserialize
75                                                              (make <oldtype-page>)
76                                                              serialized))))
77            (test "serialized == DATA (2)  "
78                  loaded-no-timeline
79                  (lambda () (serialize oldtype-page-no-timeline))))
80      (test-end)
81
82
83      (test-start "oldtype-page util method")
84     
85      (test-section "oldtype-timeline")
86      (set! oldtype-timeline (timeline-of oldtype-page))
87      (test "log of lineno 1"
88            '((revision . 8208) (committer . kiyoka) (utc . 1206016615) (rank . 5))
89            (lambda ()
90              (serialize (log-by-lineno oldtype-timeline 1))))
91
92      (test "ago string of lineno 1 <oldtype-timeline>"
93            "  (4 months ago)"
94            (lambda ()
95              (get-ago (log-by-lineno oldtype-timeline 1))))
96      (test "ago string of lineno 1 <oldtype-page>"
97            "  (4 months ago)"
98            (lambda ()
99              (get-ago oldtype-page 1)))
100     
101      (test "date string of lineno 1 <oldtype-timeline>"
102            "2008-03-20 21:36 (+0900)"
103            (lambda ()
104              (get-date (log-by-lineno oldtype-timeline 1))))
105      (test "date string of lineno 1 <oldtype-page>"
106            "2008-03-20 21:36 (+0900)"
107            (lambda ()
108              (get-date oldtype-page 1)))
109
110      (test "rank value of lineno 1 <oldtype-timeline>"
111            5
112            (lambda ()
113              (rank-by-lineno oldtype-timeline 1)))
114      (test "rank value of lineno 2 <oldtype-timeline>"
115            4
116            (lambda ()
117              (rank-by-lineno oldtype-timeline 2)))
118
119      (test "date,ago,rank,committer of lineno 1 <oldtype-page>"
120            '((date  . "2008-03-20 21:36 (+0900)")
121              (ago   . "  (4 months ago)")
122              (rank  . 5)
123              (committer . "kiyoka"))
124            (lambda ()
125              `(
126                (date      . ,(get-date      oldtype-page 1))
127                (ago       . ,(get-ago       oldtype-page 1))
128                (rank      . ,(get-rank      oldtype-page 1))
129                (committer . ,(get-committer oldtype-page 1)))))
130
131      (test "text of lineno 1 <oldtype-page>"
132            "* UnitTest用のサンプルファイル"
133            (lambda ()
134              (get-text oldtype-page 1)))
135     
136      (test "text of lineno 2 <oldtype-page>"
137            "----"
138            (lambda ()
139              (get-text oldtype-page 2)))
140
141      (test "rank-list of <oldtype-page>"
142            '(5 4 3 3 3 3)
143            (lambda ()
144              (get-rank-list oldtype-page)))
145
146     
147      (test-end)
148
149      (test-start "generating RSS")
150     
151      (test "wikiname list for RSS"
152            '((4 . "Entry1") (5 . "Entry2"))
153            (lambda ()
154              (get-rss-entry-pages oldtype-page)))
155
156      (test "oldtype-page list for RSS"
157            '(("Entry1" "Entry1の1行目" ((revision . 13304) (committer . kiyoka) (utc . 1212675369) (rank . 5)))
158              ("Entry2" "Entry2の1行目" ((revision . 13334) (committer . kiyoka) (utc . 1212756234) (rank . 4))))
159            (lambda ()
160              (map
161               (lambda (x)
162                 (let* ((page (oldtype:load-page "" (cdr x)))
163                        (timeline (timeline-of page)))
164                   `(
165                     ,(name-of page)
166                     ,(car (get-text-list page))
167                     ,(serialize
168                       (get-latest-log timeline)))))
169               (get-rss-entry-pages oldtype-page))))
170
171      (test "lines of latest revision in Test.ot"
172            '(6 5 4 3)
173            (lambda ()
174              (get-latest-lines oldtype-timeline)))
175
176      (test "The page that doesn't have RSS data."
177            '()
178            (lambda ()
179              (get-rss-entry-pages
180               (oldtype:load-page "" "Entry1"))))
181
182      (test-end)
183
184      (test-start "svn commit")
185
186      (let1 work
187            (make <svn-work> :url "http://genkan.sumibi.org/svn/newtype" :user "kahua" :pass "kahua" :basepath "/Users/kiyoka/work/tmp")
188           
189            (test "Initialize svn work directory"
190                  #t
191                  (lambda ()
192                    (string? (init work (number->string (sys-time))))))
193
194            (test "status of wikiname (no changes)"
195                  '("" "")
196                  (lambda ()
197                    (begin
198                      (display (get-fullpath work))
199                      (newline)
200                      (status work "_kiyoka"))))
201
202            (test "status of wikiname (some changes)"
203                  "M"
204                  (lambda ()
205                    (save-text-list work
206                                    "test"
207                                    `("UnitTest用ページ。" ,(number->string (sys-time))))
208                    (car (status work "test"))))
209           
210            (when
211                #t
212              (test "commit from work"
213                    #t
214                    (lambda ()
215                      (commit work)
216                      (clean work)))))
217      (test-end)
218     
219      )))
Note: See TracBrowser for help on using the browser.