Tcl Library Source Code

testsNeed TclOO 1

support {
  use [file join ${TCLLIBMOD} cmdline cmdline.tcl]      cmdline
  use [file join ${TCLLIBMOD} fileutil fileutil.tcl]    fileutil
  use [file join ${TCLLIBMOD} sha1 sha1.tcl]            sha1
  use [file join ${TCLLIBMOD} namespacex  namespacex.tcl] namespacex
  use [file join ${TCLLIBMOD} ego  ego.tcl]             ego
  use [file join ${TCLLIBMOD} chan base.tcl]            {chan base}
  use [file join ${TCLLIBMOD} chan getslimit.tcl]       {chan getslimit}
  use [file join ${TCLLIBMOD} mime qp.tcl]              {mime qp}
  use [file join ${TCLLIBMOD} mime mime.tcl]            mime
  use [file join ${TCLLIBMOD} uri uri.tcl]              uri
  use [file join ${TCLLIBMOD} dns ip.tcl]               ip
  use [file join ${TCLLIBMOD} nettool nettool.tcl]      nettool
  use [file join ${TCLLIBMOD} coroutine coroutine.tcl]  coroutine
  use [file join ${TCLLIBMOD} cron cron.tcl]            cron
  #use [file join ${TCLLIBMOD} virtchannel_core core.tcl] tcl::chan::core
  #use [file join ${TCLLIBMOD} virtchannel_core events.tcl] tcl::chan::events
  use [file join ${TCLLIBMOD} virtchannel_base memchan.tcl] tcl::chan::memchan
  use [file join ${MODDIR} clay clay.tcl]               clay
}

testing {
  useLocal httpd.tcl httpd
}

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file dirname [
	    file normalize [info script]/...]]]]/devtools/testutilities.tcl]

testsNeedTcl     8.5
testsNeedTcltest 2

support {
    # This code loads md5x, i.e. md5 v2. Proper testing should do one
    # run using md5 v1, aka md5.tcl as well.
    use md5/md5x.tcl md5

    use namespacex/namespacex.tcl namespacex
    use ego/ego.tcl   ego
    use chan/base.tcl {chan base}
    use chan/getslimit.tcl {chan getslimit}

}
testing {
    useLocal qp.tcl   {mime qp}
    useLocal mime.tcl mime
}

package require {chan base}

# -------------------------------------------------------------------------

part3
--bar--
}

    set tok [.new {} -string $msg]
    set partToks [$tok property parts]

    set res {}
    foreach childTok $partToks {
	lappend res [[$childTok body raw] read]
    }
    set res
}} [list part1 part2 part3]

    qp encode {How long is a piece of string ?} 1
}} How_long_is_a_piece_of_string_=3F


test mime-4.13 {Test qp::encode in no_softbreak mode} {cleanly {
    qp encode {This is a very long string into which we do not want inserted softbreaks as we want one very long line returned even though that's probably not how we whould be doing it (see RFC2047) but we don't want to break backward compatibility} 0 1
}} {This is a very long string into which we do not want inserted softbreaks as we want one very long line returned even though that's probably not how we whould be doing it (see RFC2047) but we don't want to break backward compatibility}



test mime-5.1 {Test word_encode with quoted-printable method} {cleanly {
    word_encode iso8859-1 quoted-printable {Test de contrôle effectué}
}} =?ISO-8859-1?Q?Test_de_contr=F4le_effectu=E9?=

    {(a b)}
    10 {(=?ISO-8859-1?Q?a?= =?ISO-8859-2?Q?_b?=)}
    {(a b)}
    11 {(=?ISO-8859-1?Q?a?=x=?ISO-8859-2?Q?_b?=)}
    {(ax b)}
    12 {a         b         c}
    {a         b         c}
    13 {}
    {}
} {
    test mime-6.$n {Test field_decode (from RFC 2047, part 8)} {cleanly {
	field_decode $encoded
    }} $expected ; # {}
}

    test mime-9.0.$name {Test chunk handling of serialize and helpers} {cleanly {
	set in [makeFile [set data [string repeat [string repeat {123456789 } 10]\n 350]] input.txt]
	set mi [makeFile {} mime.txt]

	with.$name $in -canonical text/plain {
	    ::tcllib::chan::base .new chan1 [open $mi w]
	    chan1 configure -translation binary
	    $tok serialize -chan chan1
	    chan1 close

	    with.$name $mi {
		set newdata [[$tok body raw] read]
		set res [string compare $data $newdata]

		removeFile input.txt

    set msg "MIME-Version: 1.0
Content-Type: text/plain\r
\r
so plain
"

    set tok [.new {} -string $msg]
    [$tok body raw] read
} "so plain\n"

# -------------------------------------------------------------------------

test mime-14.0 {cleanly {
	hostname argument to parseaddress
}} {
	set parsed [parseaddress hostname fakedomain.fake {Here <h>}]
    list [llength $parsed] [lindex $parsed 0]
} [list 1 [list address [email protected] comment {} domain {} error {} \
	friendly Here group {} local h memberP 0 phrase Here \
	proper {Here <[email protected]>} route {}]]

} {test/test {foo {}}}


test mime-17.9 {
    header supplied by a component message, retrieved by lowercase name
} {
    set mime [.new {} -string {Content-Disposition: form-data; name="field2"}]
    $mime header get content-disposition
} {form-data {name field2}}


test mime-17.10 {
    Content-Type is not automatically added to a subordinate
} {
    set mime [.new {} -string {Content-Disposition: form-data; name="field2"}]
    $mime header get content-disposition
} {form-data {name field2}}


test mime-18.1 {
    non-seekable channel
} {
    set script [list puts -nonewline $message1]

	cookie serialization
} {
	set mime [.new {} -spec http -string {}]
	$mime cookie set one two
	set res [$mime serialize]
	$mime .destroy
	return $res

} "Set-Cookie: one=two\r
\t; HttpOnly\r
\r
"

test mime-19.2 {
	cookie serialization
} {
	set mime [.new {} -spec http -string {}]
	$mime cookie set one two path /three/four
	set res [$mime serialize]
	$mime .destroy
	return $res

} "Set-Cookie: one=two\r
\t; path=/three/four\r
\t; HttpOnly\r
\r
"