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