# # script.test -- test readfile, evalfile and other tcl procs # 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::* } # ----------------------------------------------------------------------------- # util # ----------------------------------------------------------------------------- # ----------------------------------------------------------------------------- # readfile # ----------------------------------------------------------------------------- test script-readfile-1.1 {web::readfile (no args)} { catch { web::readfile } msg set msg if {$tcl_version < 8.4} { set res [string compare {no value given for parameter "name" to "web::readfile"} $msg] } else { set res [string compare {wrong # args: should be "web::readfile name vtarget ?vmsg?"} $msg] } } {0} test script-readfile-1.2 {web::include (to channel)} { ## make a temp file with a test script set curTim [clock seconds] set fileName $curTim-[pid]-readfile.tcl set fileId [open $fileName "w"] set text "puts $curTim-readfile" puts -nonewline $fileId $text close $fileId ## now read it web::readfile $fileName tmp ## remove file file delete $fileName set res [string compare $tmp $text] } {0} # ----------------------------------------------------------------------------- # evalfile # ----------------------------------------------------------------------------- test script-evalfile-1.1 {web::putxfile (no args)} { catch { web::putxfile } msg set msg if {$tcl_version < 8.4} { set res [string compare {no value given for parameter "file" to "web::putxfile"} $msg] } else { set res [string compare {wrong # args: should be "web::putxfile file ?channel? ?vmsg?"} $msg] } } {0} test script-evalfile-1.2 {web::putxfile (to channel)} { web::response -select \#ws3_test_script_evalfile web::response -sendheader 0 ## make a temp file with a test script set curTim [clock seconds] set fileName $curTim-[pid]-evalfile.tcl set fileId [open $fileName "w"] set text "puts $curTim" puts -nonewline $fileId $text close $fileId ## now source it web::putxfile \#ws3_test_script_evalfile $fileName ## remove file file delete $fileName set res [string compare $ws3_test_script_evalfile $text] if {$res != 0 } { puts "expected: $text." puts "found: $ws3_test_script_evalfile." } unset ws3_test_script_evalfile set res } {0} test script-evalfile-1.3 {web::putxfile and web::putx of 8-bit stuff} { web::response -select \#ws3_test_script_evalfile web::response -sendheader 0 ## make a temp file with a test script set curTim [clock seconds] set fileName $curTim-[pid]-evalfile.tcl set fileId [open $fileName "w"] set text "üöäüéàè" puts -nonewline $fileId $text close $fileId ## now source it web::putxfile \#ws3_test_script_evalfile $fileName ## add a test for include web::readfile $fileName f web::putx \#ws3_test_script_evalfile $f ## and send $text directly web::putx $text ## remove file file delete $fileName set res [string compare $ws3_test_script_evalfile $text$text$text] if {$res != 0 } { puts "expected: $text." puts "found: $ws3_test_script_evalfile." } unset ws3_test_script_evalfile set res } {0} # ----------------------------------------------------------------------------- # readfile # ----------------------------------------------------------------------------- test script-include-1.1 {web::include (no args)} { catch { web::include } msg set msg if {$tcl_version < 8.4} { set res [string compare {no value given for parameter "name" to "web::include"} $msg] } else { set res [string compare {wrong # args: should be "web::include name ?vmsg?"} $msg] } } {0} test script-include-1.2 {web::include (to channel)} { ## make a temp file with a test script set curTim [clock seconds] set fileName $curTim-[pid]-include.tcl set fileId [open $fileName "w"] set value "$curTim-include" puts $fileId "[list set includevar $value]" close $fileId ## now include it web::include $fileName ## remove file file delete $fileName set res [string compare $includevar $value] } {0} # ----------------------------------------------------------------------------- # web::match (formerly known as isselected / ischecked) # ----------------------------------------------------------------------------- test script-match-1.1 {web::match} { set res [web::match checked tv tv] } {checked} test script-match-1.2 {web::match} { set res [web::match checked vcr tv] } {} test script-match-1.3 {web::match} { set res [web::match checked {vcr dvd tv} tv] } {checked} # cleanup ::tcltest::cleanupTests