tests/dtcl.test

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

# mod_dtcl test suite, by David N. Welton <davidw@apache.org>

# See README file for more information.

# $Id$ 

package require tcltest
package require http 2.1

set urlbase "http://localhost:8080/"
set testfilename1 "dtcl-test2.ttml"
set testfilename2 "dtcl-test.tcl"


::tcltest::test hello-1.1 {hello world test} {
    set page [ ::http::geturl "${urlbase}$testfilename1" ]
    regexp -line {^Hello, World$} [ ::http::data $page ]
} 1

::tcltest::test i18n-1.1 {I18N test} {
    set page [ ::http::geturl "${urlbase}$testfilename1" ]
    regexp -line {^¡ À È Ì Ò Ù - El Burro Sabe Más Que Tú!$} [ ::http::data $page ]
} 1

::tcltest::test getvariables-1.1 {GET variables} {
    set page [ ::http::geturl "${urlbase}$testfilename1?foobar=goober" ]
    regexp -line {^VARS\(foobar\) = goober$} [ ::http::data $page ]
} 1

::tcltest::test getvariables-1.2 {GET variables + I18N} {
    set page [ ::http::geturl "${urlbase}$testfilename1?Más=Tú" ]
    regexp -line {^VARS\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test getvariables-1.3 {GET variables + I18N + encoding} {
    set page [ ::http::geturl [ format "${urlbase}$testfilename1?%s" [ ::http::formatQuery Más Tú ] ] ]
    regexp -line {^VARS\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test postvariables-1.1 {POST variables} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -query foobar=goober ]
    regexp -line {^VARS\(foobar\) = goober$} [ ::http::data $page ]
} 1

::tcltest::test postvariables-1.2 {POST variables + I18N} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -query Más=Tú ]
    regexp -line {^VARS\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test postvariables-1.3 {POST variables + I18N + encoding} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -query [ ::http::formatQuery Más Tú ] ]
    regexp -line {^VARS\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test multivariables-1.1 {multiple variables: foo=1&foo=2} {
    set page [ ::http::geturl "${urlbase}$testfilename1?foobar=1&foobar=2&foobar=foo+bar" ]
    regexp -line {^VARS\(foobar\) = 1 2 foo bar$} [ ::http::data $page ]
} 1

::tcltest::test env-1.1 {Environment variable} {
    set page [ ::http::geturl "${urlbase}$testfilename1" ]
    regexp -line "^ENVS\\(DOCUMENT_NAME\\) = $testfilename1\$" [ ::http::data $page ]
} 1

::tcltest::test cookies-1.1 {Cookies} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "foo=bar"} ]
    regexp -line {^COOKIES\(foo\) = bar$} [ ::http::data $page ]
} 1

::tcltest::test cookies-1.2 {Cookies + I18N} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "Más=Tú"} ]
    regexp -line {^COOKIES\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test cookies-1.3 {Cookies + I18N + encoding} {
    set page [ ::http::geturl "${urlbase}$testfilename1" -headers [ list Cookie [ ::http::formatQuery Más Tú ] ] ]
    regexp -line {^COOKIES\(Más\) = Tú$} [ ::http::data $page ]
} 1

::tcltest::test cookies-1.4 {Multiple Cookies} {
    set rslt 0
    set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "bop; foo=bar;doo=wah; shoo=be ;doooo=bee;dot=dow  "} ]
    set pgdata [ ::http::data $page ]
    incr rslt [ regexp -line {^COOKIES\(foo\) = bar$} $pgdata ]
    incr rslt [ regexp -line {^COOKIES\(doo\) = wah} $pgdata ]
    incr rslt [ regexp -line {^COOKIES\(shoo\) = be} $pgdata ]
    incr rslt [ regexp -line {^COOKIES\(doooo\) = bee} $pgdata ]
    incr rslt [ regexp -line {^COOKIES\(dot\) = dow$} $pgdata ]
    incr rslt [ regexp -line {^COOKIES\(bop\) = } $pgdata ]
} 6

::tcltest::test servercookies-1.1 {Cookies from Server} {
    set rslt 0
    set page [ ::http::geturl "${urlbase}$testfilename1" ]
    upvar 0 $page state
    array set statehash $state(meta)
    regexp -line {mod=dtcl; path=[^;]*; expires=01-01-2003} $statehash(Set-Cookie)
} 1

::tcltest::test tclfile-1.1 {Plain .tcl file} {
    set page [ ::http::geturl "${urlbase}$testfilename2" ]
    set pgdata [string trim [ ::http::data $page ] ]
} "¡ À È Ì Ò Ù - El Burro Sabe Más Que Tú!"

::tcltest::cleanupTests