1# -*- tcl -*-
2# Tests for the utilities to the logger facility.
3#
4# Sourcing this file into Tcl runs the tests and generates output for errors.
5# No output means no errors were found.
6#
7# Copyright (c) 2005 by Aamer Aahkter
8
9# -------------------------------------------------------------------------
10
11source [file join \
12	[file dirname [file dirname [file join [pwd] [info script]]]] \
13	devtools testutilities.tcl]
14
15testsNeedTcl     8.4
16testsNeedTcltest 2.2
17
18support {
19    useLocal logger.tcl         logger
20    useLocal loggerAppender.tcl logger::appender
21}
22testing {
23    useLocal loggerUtils.tcl logger::utils
24}
25
26# -------------------------------------------------------------------------
27
28logger::setlevel debug
29
30proc msg {name {suffix {}}} {
31    lappend map @ $name ! $suffix
32    return [string map $map {\[[\d:\/ ]+\] \[@\] \[namespace\] \[error\] this is error!}]
33}
34
35# -------------------------------------------------------------------------
36
37::tcltest::test createFormatCmd-1 {check for %d} -cleanup {
38    unset a b
39} -body {
40    set a [logger::utils::createFormatCmd %d]
41    set b [subst $::a]
42    regexp {\d\d\d\d/\d\d/\d\d \d\d:\d\d:\d\d} $b
43} -result {1}
44
45::tcltest::test createFormatCmd-2 {check for %P} -cleanup {
46    unset a b
47} -body {
48    set a [logger::utils::createFormatCmd %P]
49    set b [subst $a]
50} -result [pid]
51
52::tcltest::test createFormatCmd-3 {check for %H} -cleanup {
53    unset a b
54} -body {
55    set a [logger::utils::createFormatCmd %H]
56    set b [subst $a]
57} -result [info hostname]
58
59::tcltest::test createFormatCmd-4 {check for %c} -cleanup {
60    unset a b
61} -body {
62    set a [logger::utils::createFormatCmd %c -category test::cat ]
63    set b [subst $a]
64} -result test::cat
65
66::tcltest::test createFormatCmd-5 {check for %C} -cleanup {
67    unset a b
68} -body {
69    set a [logger::utils::createFormatCmd %C -category test::cat ]
70    set b [subst $a]
71} -result test
72
73::tcltest::test createFormatCmd-6 {check for %p} -cleanup {
74    unset a b
75} -body {
76    set a [logger::utils::createFormatCmd %p -category test::cat -priority error]
77    set b [subst $a]
78} -result error
79
80::tcltest::test createLogProc-1 {create a proc and test it} -cleanup {
81    rename ::bobo {}
82    namespace delete ::loggerExtension::test
83} -body {
84    eval [logger::utils::createLogProc \
85	      -category catTest \
86	      -priority critical \
87	      -procName ::bobo \
88	      -conversionPattern {\[%d\] \[%c\] \[%M\] \[%p\] %m}]
89    namespace eval ::loggerExtension::test {
90	::bobo test
91    }
92}  -match regexp -output {\[[\d:\/ ]+\] \[catTest\] \[namespace\] \[critical\] test}
93
94
95::tcltest::test createLogProc-2 {tkt e4d5ef01e7, %M OO context} -constraints tcl8.5plus -setup {
96    package require TclOO
97    ::oo::class create Main {
98	variable log
99	constructor {} {
100	    set this_inst [namespace current]
101	    set this_klaz [info object class $this_inst]
102	    set log [::logger::init $this_klaz]
103	    ::logger::utils::applyAppender \
104		-appender "console" \
105		-appenderArgs {-conversionPattern {%d \[%p\] \[%M\] %m}} \
106		-serviceCmd $log
107	}
108	method invoke {} {
109	    ${log}::info "hello"
110	}
111    }
112    set main [Main new]
113} -cleanup {
114    $main destroy
115    unset main
116    Main destroy
117} -body {
118    $main invoke
119} -match regexp -output {[\d:\/ ]+ \[info\] \[::Main::invoke\] hello}
120
121::tcltest::test applyAppender-1 {apply an appender} -cleanup {
122    ${log}::delete
123    unset log
124    namespace delete ::loggerExtension::test
125} -body {
126    set log [logger::init testLog]
127    logger::utils::applyAppender -appender console -serviceCmd $log
128    namespace eval ::loggerExtension::test {
129	${::log}::error "this is error"
130    }
131} -match regexp -output [msg testLog]
132
133::tcltest::test applyAppender-2 {apply an appender, to 2 loggers} -cleanup {
134    ${log1}::delete
135    ${log2}::delete
136    unset log1
137    unset log2
138    namespace delete ::loggerExtension::test
139} -body {
140    set log1 [logger::init testLog1]
141    set log2 [logger::init testLog2]
142    logger::utils::applyAppender -appender console -serviceCmd [list $log1 $log2]
143    namespace eval ::loggerExtension::test {
144	${::log1}::error "this is error1"
145	${::log2}::error "this is error2"
146    }
147} -match regexp -output [msg testLog1 1]\n[msg testLog2 2]
148
149::tcltest::test applyAppender-3 {auto apply} -cleanup {
150    ${log}::delete
151    unset log
152    namespace delete ::loggerExtension::test
153} -body {
154    logger::utils::applyAppender -appender console
155    set log [logger::init applyAppender-3]
156    namespace eval ::loggerExtension::test {
157	${::log}::error "this is error"
158    }
159} -match regexp -output [msg applyAppender-3]
160
161::tcltest::test applyAppender-4 {auto apply} -cleanup {
162    ${log}::delete
163    unset log
164    namespace delete ::loggerExtension::test
165} -body {
166    logger::utils::applyAppender -appender colorConsole
167    set log [logger::init applyAppender-4]
168    namespace eval ::loggerExtension::test {
169	${::log}::error "this is error"
170    }
171} -match regexp -output [msg applyAppender-4]
172
173::tcltest::test applyAppender-5 {auto apply fileAppend} -cleanup {
174    ${log}::delete
175    unset log
176    namespace delete ::loggerExtension::test
177} -body {
178    logger::utils::applyAppender \
179	-appender fileAppend \
180	-appenderArgs {-outputChannel stderr}
181    set log [logger::init applyAppender-5]
182    namespace eval ::loggerExtension::test {
183	${::log}::error "this is error"
184    }
185} -match regexp -errorOutput [msg applyAppender-5]
186
187# -------------------------------------------------------------------------
188
189testsuiteCleanup
190return
191# ;;; Local Variables: ***
192# ;;; mode: tcl ***
193# ;;; End: ***
194