# # msc.test -- misc stuff that did not fit anywhere elese # nca-073-9 # # Copyright (c) 1996-2000 by Netcetera AG. # Copyright (c) 2001 by Apache Software Foundation. # All rights reserved. # # See the file "license.terms" for information on usage and # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # @(#) $Id$ # # ----------------------------------------------------------------------------- # tcltest package # ----------------------------------------------------------------------------- if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import ::tcltest::* } web::tempfile -remove # ----------------------------------------------------------------------------- # creation and 'normal' usage # ----------------------------------------------------------------------------- test copyright-1.0 {web::config copyright} { set res {} set tmp [web::config copyright] lappend res [regexp {http://netcetera\.ch} $tmp] lappend res [regexp {http://tcl\.apache\.org/websh} $tmp] set res } {1 1} test tempfile-1.0a {web::tempfile dir prefix} {unixOnly} { set home "/tmp" if {[info exists env(HOME)]} { set home $env(HOME) } elseif {[info exists env(TMP)]} { set home $env(TMP) } set tmp [web::tempfile -path $home -prefix "prefix"] set msg "" if {[string match "[file join $home prefi]*" $tmp]} { set fh [open $tmp w] if {[file exists $tmp]} { set msg ok ## Websh will try to remove file at end } else { set msg "filename $tmp not on file system" } close $fh } else { set msg "filename $tmp does not satisfy specs" } set msg } {ok} test tempfile-1.0b {web::tempfile dir prefix} {pcOnly} { set tmp [web::tempfile -prefix "prefix"] set msg "" if {[string match "*prefi*" $tmp]} { set fh [open $tmp w] if {[file exists $tmp]} { set msg ok ## Websh will try to remove file at end } else { set msg "filename $tmp not on file system" } close $fh } else { set msg "filename $tmp does not satisfy specs" } set msg } {ok} test tempfile-1.2 {web::tempfile reject invalid dir} { set tmp [web::tempfile -path "/tmp/yoyoy" -prefix "prefix"] set msg "" if {[string match "/tmp/yoyoy*" $tmp]} { global tcl_platform if {"$tcl_platform(platform)" == "unix" && "$tcl_platform(os)" == "Darwin"} { # OSX does not complain if directory does not exist # It just returns the nonexistig path anyway set msg "ok" } else { set msg "error: accepted non-existing dir $tmp" } } elseif {[string match "*prefi*" $tmp]} { set msg "ok" } else { set msg "error: rejected valid prefix" } set msg } {ok} test tempfile-1.3 {temporary file name} { set fn [web::tempfile] file exists $fn } {0} proc createFile filename { set fh [open $filename w] puts $fh x close $fh } test tempfile-1.4 {remove temporary files} {} { foreach f {f1 f2 f3 f4 f5 f6} { set $f [web::tempfile] createFile [set $f] } web::tempfile -remove set exist 0 foreach f {f1 f2 f3 f4 f5 f6} { incr exist [file exists [set $f]] } set exist } {0} test request-1.1 {access env var} { set res [web::request -set websh_test_11 "the Websh guy"] lappend res [web::request -set websh_test_11] lappend res [web::request -set FOO_ENV_VAR] set res } {the Websh guy {the Websh guy} {}} test request-1.2 {without subcommand} { web::request -set websh_test_12 "the Websh guy" set res [web::request websh_test_12] lappend res [web::request FOO_ENV_VAR "bar_env"] set res } {the Websh guy bar_env} test request-1.3 {-exists} { set res [web::request -count websh_test_13] web::request -set websh_test_13 "the Websh guy" "and the test guy" lappend res [web::request -count websh_test_13] web::request -unset websh_test_13 lappend res [web::request -count websh_test_13] set res } {0 2 0} test request-1.4 {-names} { web::request -set websh_test_14 "the Websh guy" set tmp [web::request -names] set res [expr [llength $tmp] > 1] lappend res [expr [lsearch $tmp "websh_test_14"] != -1] set res } {1 1} #fixme: these need some work... test modwebsh-1.1 {initialzer} { web::initializer {set tst "modwebsh1_1"} } {modwebsh1_1} test modwebsh-1.2 {finalizer} { web::finalizer {set tst "modwebsh1_2"} } {modwebsh1_2} test modwebsh-1.3 {maineval} { web::maineval {foo} } {} test modwebsh-1.4 {interpclass} { web::interpcfg {foo} } {} test modwebsh-1.5 {interpclasscfg} { web::interpclasscfg {foo} } {} test modwebsh-1.6 {web::config mod_websh vars} { global env set env(SERVER_ROOT) SeRo set env(DOCUMENT_ROOT) DoRo set env(SCRIPT_FILENAME) ScFn set res {} lappend res [web::config script] lappend res [web::config server_root] lappend res [web::config document_root] lappend res [web::config interpclass] unset env(SERVER_ROOT) unset env(DOCUMENT_ROOT) unset env(SCRIPT_FILENAME) set res } {ScFn SeRo DoRo ScFn} # cleanup ::tcltest::cleanupTests