#!/bin/sh # the next line restarts using tclsh \ exec tclsh "$0" "$@" # mod_dtcl test suite, by David N. Welton # 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