source: project/logging/tests/logging-test.scm @ 5074

Last change on this file since 5074 was 5074, checked in by Kon Lovett, 13 years ago

Changed to chicken-setup tests directory structure.

File size: 3.9 KB
Line 
1;;;; logging-test.scm
2
3(use testbase testbase-output-human)
4(use logging)
5(use logging-objects)
6(use logging-files)
7(use utils posix)
8
9(define-for-syntax test::timing #f)
10
11#| TestBase
12
13  (test
14    (purpose "Checkout logging build.")
15    (reader-extension logging) )
16|#
17
18(define-expect-unary procedure?)
19
20(define-test logging-parameters-test "Logging Parameters"
21
22        (test/case "Initial Parameters"
23
24                (expect-equal "default-logbook-indent-amount"
25                        2 #;DEFAULT-INDENT-AMOUNT
26                        (current-logbook-indent-amount))
27
28                (expect-procedure "current-logbook-format-procedure" (current-logbook-format-procedure))
29
30                (expect-equal "default-logbook"
31                        'message
32                        (default-logbook))
33
34                (expect-equal "default-logbook-directory"
35                        #f
36                        (default-logbook-directory))
37
38                (expect-equal "default-logbook-extension"
39                        "log"
40                        (default-logbook-extension))
41
42                (expect-equal "default-logbook-entries"
43                        '(message)
44                        (default-logbook-entries))
45
46                (expect-equal "default-logbook-entry"
47                        'message
48                        (default-logbook-entry))
49
50                (expect-equal "default-logbook-sources"
51                        '(all)
52                        (default-logbook-sources))
53
54                (expect-equal "default-logbook-source"
55                        'all
56                        (default-logbook-source))
57
58                (expect-equal "default-logbook-level"
59                        'all
60                        (default-logbook-level))
61
62                (expect-equal "default-entry-level"
63                        'all
64                        (default-entry-level))
65
66                (expect-equal "default-logbook-fields"
67                        (list 'timestamp " " '(? source " ") '(? level " "))
68                        (default-logbook-fields))
69
70                (expect-equal "default-entry-fields"
71                        '(timestamp " " (? source " ") (? level " "))
72                        (default-entry-fields))
73
74                (expect-equal "default-logbook-echos"
75                        '()
76                        (default-logbook-echos))
77
78                (expect-equal "default-logbook-alternates"
79                        '()
80                        (default-logbook-alternates))
81
82                (expect-procedure "default-asynchronous-error" (default-asynchronous-error))
83
84                (expect-equal "default-logbook-catalog"
85                        (make-pathname (repository-path) "logbook-catalog" #;LOGBOOK-CATALOG-FILENAME)
86                        (default-logbook-catalog))
87
88                #;(expect-equal "default-file-permissions"
89                        (bitwise-ior perm/irusr perm/iwusr perm/irgrp perm/iroth)
90                        (default-file-permissions))
91        )
92
93        #;(test/case "Changing Parameters"
94
95        )
96)
97
98(define-test logging-basics-test "Logging Basics"
99
100        (test/case "Message Construction"
101
102                (expect-equal "make-log-string w/ defaults"
103                  (warn "Fails due to actual time; hard to capture.")
104                        "" (make-log-string "foo " "bar " "baz"))
105        )
106
107        (test/case "Builtin Logs"
108
109                (expect-success (log-message "foo bar baz"))
110
111                (expect-success (log-format "foor ~A bazr" "barr"))
112
113                (expect-success (log-message 'error "foo bar baz"))
114
115                (expect-success (log-format 'error "foor ~A bazr" "barr" #:asynchronous? #t))
116
117                (expect-success (log-message "froo brar braz" #:asynchronous? #t))
118
119                (expect-success (log-format 'error "foob ~A bazb" "barb"))
120
121                (expect-success (log-format 'system "foob ~A bazb" "barb"))
122
123                (expect-success (log-format 'console "foob ~A bazb" "barb"))
124        )
125
126        (test/case "Logging Level" (
127                        [ent #f] )
128
129                (expect-set! ent
130                        (make-logbook-entry 'foo #:indent 2 #:level 'debug
131                                'timestamp  " " '(? source " ") 'level 'pid ": "))
132
133                (expect-success (set-logbook-level! 'message 'notice))
134
135                (expect-success (log-message "nothing" #:entry ent #:level 'debug))
136
137                (expect-success (set-logbook-level! 'message 'debug))
138
139                (expect-success (log-message "something" #:entry ent #:level 'debug))
140        )
141
142        (test/case "Mail Logs" (
143                        [ml #f] )
144   
145          ; Note that authority is not actually part of the mailto std RFC2368.
146          (expect-success
147      (default-mail-authority
148        (list "klovett@pacbell.net:*" "smtp.pacbell.yahoo.com" DEFAULT-SMTP-PORT)))
149                (expect-set! ml
150                        (make-logbook 'mailtest
151                                #:pathname "mailto:klovett@pacbell.net"
152                                #:echos '()
153                                #:alternates '()))
154
155                (expect-success (warn "This will fail since smtp egg doesn't suppport authentication.")
156                  (log-message ml "foo bar baz"))
157        )
158)
159
160(test::for-each (cut test::styler-set! <> test::output-style-human))
161(run-test "Logging Tests")
Note: See TracBrowser for help on using the repository browser.