# Tests for the html module.
#
# This file contains a collection of tests for a module in the
# Standard Tcl Library. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1998-2000 by Ajuba Solutions.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: html.test,v 1.13 2002/12/02 04:11:28 gwlester Exp $
package require tcltest
namespace import -force ::tcltest::*
set myFile [file join [file dirname [info script]] html.tcl]
source $myFile
package require html 1.2
#source [file join [file dirname [info script]] ../ncgi/ncgi.tcl]
#package require ncgi
test html-1.1 {html::init} {
html::init
list [array exists html::defaults] \
[array size html::defaults] \
[info exists html::page]
} {1 0 0}
test html-1.2 {html::init} {
html::init {
font.face arial
body.bgcolor white
body.text black
}
lsort [array names html::defaults]
} {body.bgcolor body.text font.face}
test html-1.3 {html::init} {
catch {html::init wrong num args}
} 1
test html-1.4 {html::init} {
catch {html::init {wrong num args}}
} 1
test html-2.1 {html::head} {
catch {html::head}
} 1
test html-2.2 {html::head} {
html::head "The Title"
} "
\n\tThe Title\n\n"
test html-2.3 {html::head} {
html::description "The Description"
html::keywords key word
html::author "Cathy Coder"
html::meta metakey metavalue
html::head "The Title"
} {
The Title
}
test html-3.1 {html::title} {
catch html::title
} 1
test html-3.2 {html::title} {
html::title "blah blah"
} "blah blah\n"
test html-4.1 {html::getTitle} {
html::init
html::getTitle
} ""
test html-4.2 {html::getTitle} {
html::init
html::title "blah blah"
html::getTitle
} {blah blah}
test html-5.1 {html::meta} {
html::init
html::meta one two
} {}
test html-5.2 {html::meta} {
html::init
html::meta one two
lindex $html::page(meta) 0
} {}
test html-5.3 {html::meta} {
html::init
html::meta one {"one val"}
lindex $html::page(meta) 0
} {}
test html-6.1 {html::keywords} {
html::init
html::keywords one two
} {}
test html-6.2 {html::keywords} {
html::init
html::keywords one two
lindex $html::page(meta) 0
} {}
test html-6.3 {html::keywords} {
html::init
html::keywords one {"one val"} &
lindex $html::page(meta) 0
} {}
test html-7.1 {html::description} {
html::init
html::description "This is the description."
} {}
test html-7.2 {html::description} {
html::init
html::description "This is the description."
lindex $html::page(meta) 0
} {}
test html-7.3 {html::description} {
html::init
html::description {one "one val" &}
lindex $html::page(meta) 0
} {}
test html-8.1 {html::author} {
html::init
html::author "This is the author."
} {}
test html-8.2 {html::author} {
html::init
html::author "This is the author."
set html::page(author)
} {
}
test html-8.3 {html::author} {
html::init
html::author {one "one val" &}
set html::page(author)
} {
}
test html-2.1 {html::tagParams} {
html::init {
body.bgcolor red
font.face times
}
html::tagParam font color="red"
} {color="red" face="times"}
test html-9.1 {html::default} {
html::init {
body.bgcolor red
font.face times
}
html::default xyzzy
} {}
test html-9.2 {html::default} {
html::init {
body.bgcolor red
font.face times
}
html::default body.bgcolor
} { bgcolor="red"}
test html-9.3 {html::default} {
html::init {
body.bgcolor red
font.face times
}
html::default font.face "face=arial"
} {}
test html-9.4 {html::default} {
html::init {
body.bgcolor red
font.face times
}
html::default font.face "color=blue size=1"
} { face="times"}
test html-10.1 {html::bodyTag} {
html::init
html::bodyTag
} {
}
test html-10.2 {html::bodyTag} {
html::init {
body.bgcolor white
body.text black
}
html::bodyTag
} {
}
test html-10.3 {html::bodyTag} {
html::init {
body.bgcolor white
body.text black
}
html::bodyTag "text=red"
} {
}
test html-11.1 {html::formValue} {
ncgi::reset name=value
ncgi::parse
html::formValue name
} {name="name" value="value"}
test html-11.2 {html::formValue} {
ncgi::reset name=value
ncgi::parse
html::formValue name2
} {name="name2" value=""}
test html-11.3 {html::formValue} {
ncgi::reset "name=one+value&name2=%7e"
ncgi::parse
html::formValue name2
} {name="name2" value="~"}
test html-12.1 {html::quoteFormValue} {
html::quoteFormValue name2
} {name2}
test html-12.2 {html::quoteFormValue} {
html::quoteFormValue {"name2"}
} {"name2"}
test html-12.3 {html::quoteFormValue} {
html::quoteFormValue {"'><&} ;# need a " for balance
} {"'><&}
test html-12.4 {html::quoteFormValue} {
html::quoteFormValue "This is the value."
} {This is the value.}
test html-13.1 {html::textInput} {
html::init
ncgi::reset
ncgi::parse
html::textInput email
} {
}
test html-13.2 {html::textInput} {
html::init
ncgi::reset email=welch@scriptics.com
ncgi::parse
html::textInput email
} {
}
test html-13.3 {html::textInput} {
html::init {
input.size 30
}
ncgi::reset
ncgi::parse
html::textInput email
} {
}
test html-13.4 {html::textInput} {
html::init {
input.size 30
}
ncgi::reset
ncgi::parse
html::textInput email default@foo.com
} {
}
test html-13.5 {html::textInput} {
html::init
ncgi::reset email=welch@scriptics.com
ncgi::parse
html::textInput email value=default@foo.com
} {
}
test html-13.6 {html::textInput} {
html::init
ncgi::reset
ncgi::parse
html::textInput email default@foo.com size=80
} {
}
test html-14.1 {html::textInputRow} {
html::init
ncgi::reset email=welch@scriptics.com
ncgi::parse
html::textInputRow Email email
} {
Email
}
test html-15.1 {html::passwordInput} {
html::passwordInput
} {
}
test html-15.2 {html::passwordInput} {
html::passwordInput form_pass
} {
}
test html-16.1 {html::checkbox} {
ncgi::reset email=welch@scriptics.com
ncgi::parse
html::checkbox item value
} {
}
test html-16.2 {html::checkbox} {
ncgi::reset email=welch@scriptics.com
ncgi::parse
html::checkbox email value
} {
}
test html-17.1 {html::checkValue} {
ncgi::reset item=xyz
ncgi::parse
html::checkbox item xyz
} {
}
test html-18.1 {html::radioValue} {
ncgi::reset item=xyz
ncgi::parse
html::radioValue item xyz
} {name="item" value="xyz" CHECKED}
test html-19.1 {html::radioSet} {
ncgi::reset item=2
ncgi::parse
html::radioSet item " |\n" {
One 1
Two 2
Three 3
}
} { One |
Two |
Three}
test html-20.1 {html::checkSet} {
ncgi::reset item=2&item=3+4&x=y
ncgi::parse
html::checkSet item " |\n" {
One 1
Two 2
Three {3 4}
}
} { One |
Two |
Three}
test html-21.1 {html::select} {
ncgi::reset item=2&x=y
ncgi::parse
html::select item "multiple" {
One 1
Two 2
Three {3 4}
}
} {
}
test html-22.1 {html::selectPlain} {
ncgi::reset item=Three
ncgi::parse
html::selectPlain item "" {
One Two Three
}
} {
}
test html-22.2 {html::selectPlain} {
ncgi::reset item=Three
ncgi::parse
html::selectPlain another "" {
One Two Three
} One
} {
}
test html-23.1 {html::textarea} {
ncgi::reset item=Three
ncgi::parse
html::textarea info
} {
}
test html-23.2 {html::textarea} {
html::init {
textarea.cols 50
textarea.rows 8
}
ncgi::reset info=[ncgi::encode "The textarea value."]
ncgi::parse
html::textarea info
} {
}
test html-24.1 {html::submit} {
catch {html::submit}
} {1}
test html-24.1 {html::submit} {
catch {html::submit wrong num args}
} {1}
test html-24.1 {html::submit} {
html::submit "Push Me"
} {
}
test html-24.2 {html::submit} {
html::submit "Push Me" push
} {
}
test html-25.1 {html::varEmpty} {
catch {html::varEmpty}
} 1
test html-25.2 {html::varEmpty} {
catch {html::varEmpty wrong num args}
} 1
test html-25.3 {html::varEmpty} {
if {[info exist x]} {
unset x
}
html::varEmpty x
} 1
test html-25.4 {html::varEmpty} {
if {[info exist x]} {
unset x
}
set x ""
html::varEmpty x
} 1
test html-25.3 {html::varEmpty} {
if {[info exist x]} {
unset x
}
set x "foo"
html::varEmpty x
} 0
test html-26.1 {html::refresh} {
catch {html::refresh}
} 1
test html-26.2 {html::refresh} {
catch {html::refresh wrong num args}
} 1
test html-26.2 {html::refresh} {
html::refresh 4
} {}
test html-26.3 {html::refresh} {
html::init
html::refresh 4
html::head title
} {
title
}
test html-26.4 {html::refresh} {
html::init
html::refresh 9 http://www.scriptics.com
html::head title
} {
title
}
test html-27.1 {html::foreach--1 var, 1 iteration} {
html::foreach x {a} {
$x
}
} {
a
}
test html-27.2 {html::foreach--1 var, multiple iterations} {
html::foreach x {a b} {
$x
}
} {
a
b
}
test html-27.3 {html::foreach--1 var, 0 iterations} {
html::foreach x {} {
}
test html-27.5 {html::foreach--multiple vars, multiple iterations} {
html::foreach {x y} {a b c d} {
$x
$y
}
} {
a
b
c
d
}
test html-27.6 {html::foreach--multiple varlists and vallists} {
html::foreach {a b} {1 2 3 4} {c d} {5 6 7 8} {e f} {9 10 11 12} {
$a$b$c$d$e$f}
} {
1256910
34781112}
test html-27.7 {html::foreach--subst body w/ vars and procs} {
html::foreach x {2 8} {
$x
[incr x]
}
} {
2
3
8
9
}
test html-27.8 {html::foreach--subst body w/ nested foreach} {
html::foreach x {a b} {
[html::foreach y {c d} {$x$y}]
}
} {
acad
bcbd
}
test html-27.9 {html::foreach--subst body w/ multiple nested foreach's} {
html::foreach x {a b} {
[html::foreach y {c d} {$x$y
[html::foreach z {e f} {$z}]
}]}
} {
ac
ef
ad
ef
bc
ef
bd
ef
}
test html-28.1 {html::for--1 iteration} {
html::for {set i 0} {$i < 1} {incr i} {
$i
}
} {
0
}
test html-28.2 {html::for--multiple iterations} {
html::for {set i 0} {$i < 3} {incr i} {
$i
}
} {
0
1
2
}
test html-28.3 {html::for--0 iterations} {
html::for {set i 0} {$i < 0} {incr i} {
$i
}
} {}
test html-28.4 {html::for--complex start, text, and next} {
html::for {set i 0; set j 10} {$i < 1 && $j < 11} {incr i; incr j} {$i $j}
} {0 10}
test html-28.5 {html::for--subst body w/ vars and procs} {
html::for {set i 0} {$i < 3} {incr i} {$i [expr {$i + 5}] }
} {0 5 1 6 2 7 }
test html-28.6 {html::for--subst body w/ nested for} {
set result [html::for {set i 0} {$i < 3} {incr i} {
[html::for {set j $i} {$j < 3} {incr j} {${i}__${j} }]
}]
regsub -all "\n" $result " " result
regsub -all " +" $result " " result
set result
} { 0__0 0__1 0__2 1__1 1__2 2__2 }
test html-28.7 {html::for--subst body w/ multiple nested for's} {
set result [html::for {set i 0} {$i < 3} {incr i} {
[html::for {set j $i} {$j < 3} {incr j} {
[html::for {set k $j} {$k < 3} {incr k} {${i}__${j}__${k} }]
}]
}]
regsub -all "\n" $result " " result
regsub -all " +" $result " " result
set result
} { 0__0__0 0__0__1 0__0__2 0__1__1 0__1__2 0__2__2 1__1__1 1__1__2 1__2__2 2__2__2 }
test html-29.1 {html::while--1 iteration} {
set i 0
html::while {$i < 1} {
$i, [incr i]
}
} {
0, 1
}
test html-29.2 {html::while--multiple iterations} {
set i 0
html::while {$i < 3} {
$i, [incr i]
}
} {
0, 1
1, 2
2, 3
}
test html-29.3 {html::while--0 iterations} {
set i 0
html::while {$i < 0} {
$i
}
} {}
test html-29.4 {html::while--complex start, text, and next} {
set i 0
set j 10
html::while {$i < 1 && $j < 11} {$i $j, [incr i] [incr j]}
} {0 10, 1 11}
test html-29.5 {html::while--subst body w/ nested while} {
set i 0
set result [html::while {$i < 3} {
[set j $i]
[html::while {$j < 3} {
${i}__${j}
[incr j]
}]
[incr i]
}]
regsub -all "\n" $result " " result
regsub -all " +" $result " " result
set result
} { 0 0__0 1 0__1 2 0__2 3 1 1 1__1 2 1__2 3 2 2 2__2 3 3 }
test html-29.7 {html::while--subst body w/ multiple nested while's} {
set i 0
set result [html::while {$i < 3} {
[set j $i]
[html::while {$j != 3} {
[set k $j]
[html::while {$k != 3} {
${i}__${j}__${k}
[incr k]
}]
[incr j]
}]
[incr i]
}]
regsub -all "\n" $result " " result
regsub -all " +" $result " " result
set result
} { 0 0 0__0__0 1 0__0__1 2 0__0__2 3 1 1 0__1__1 2 0__1__2 3 2 2 0__2__2 3 3 1 1 1 1__1__1 2 1__1__2 3 2 2 1__2__2 3 3 2 2 2 2__2__2 3 3 3 }
test html-30.1 {html::if--eval then clause} {
set i 0
html::if {$i < 1} {$i, [incr i]}
} {0, 1}
test html-30.2 {html::if--don't eval then clause} {
set i 0
html::if {$i == 1} {$i, [incr i]}
} {}
test html-30.3 {html::if--eval else clause} {
set i 0
html::if {$i == 1} {then clause} else {$i, [incr i]}
} {0, 1}
test html-30.4 {html::if--1 elseif clause, eval else cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 1} {
elseif clause
} else {$i, [incr i]}
} {0, 1}
test html-30.5 {html::if--1 elseif clause, eval elseif cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 0} {$i, [incr i]}
} {0, 1}
test html-30.6 {html::if--1 elseif clause, eval elseif cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 1} {
$i, [incr i]
}
} {}
test html-30.7 {html::if--1 elseif clause, eval elseif cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 0} {$i, [incr i]} else {
else clause
}
} {0, 1}
test html-30.8 {html::if--1 elseif clause, eval elseif cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 1} {
elseif1 clause
} elseif {$i == 0} {$i, [incr i]} elseif {$i == 2} {
elseif3 clause
} else {
else clause
}
} {0, 1}
test html-30.9 {html::if--1 elseif clause, eval elseif cause} {
set i 0
html::if {$i < 0} {
then clause
} elseif {$i == 1} {
elseif3 clause
} elseif {$i == 2} {
elseif1 clause
} elseif {$i == 0} {$i, [incr i]} else {
else clause
}
} {0, 1}
test html-30.10 {html::if--multiple nested} {
set i 0
set result [html::if {$i < 1} {
begin1
[html::if {$i > -1} {
begin2
[html::if {$i == 0} {
begin3
[html::if {$i} {4}]
end3
}]
end2
}]
end1
}]
regsub -all "\n" $result " " result
regsub -all " +" $result " " result
set result
} { begin1 begin2 begin3 end3 end2 end1 }
test html-31.1 {html::set--set a new variable} {
set result [html::set x 1]
list $result $x
} {{} 1}
test html-31.2 {html::set--set an existing variable} {
set x 0
set result [html::set x 1]
list $result $x
} {{} 1}
test html-32.1 {single argument} {
set x 0
set result [html::eval {set x [format 22]}]
list $result $x
} {{} 22}
test html-32.2 {multiple arguments} {
set a {$b}
set b xyzzy
set x 0
set result [html::eval {set x [eval format $a]}]
list $result $x
} {{} xyzzy}
test html-32.3 {single argument} {
set x [list]
set y 1
set result [html::eval lappend x a b c d {$y} e f g]
list $result $x
} {{} {a b c d 1 e f g}}
test html-32.4 {error: not enough arguments} {catch html::eval} 1
test html-32.5 {error: not enough arguments} {
catch html::eval msg
set msg
} {wrong # args: should be "uplevel ?level? command ?arg ...?"}
test html-32.6 {error in eval'ed command} {
catch {html::eval {error "test error"}}
} 1
test html-32.7 {error in eval'ed command} {
catch {html::eval {error "test error"}} msg
set msg
} {test error}
tcltest::cleanupTests