diff options
| -rw-r--r-- | ChangeLog | 49 | ||||
| -rw-r--r-- | generic/tclOOMethod.c | 2 | ||||
| -rw-r--r-- | generic/tclProc.c | 2 | ||||
| -rw-r--r-- | library/http/http.tcl | 8 | ||||
| -rw-r--r-- | tests/http.test | 26 | ||||
| -rw-r--r-- | tests/httpd | 8 | ||||
| -rw-r--r-- | tests/oo.test | 12 |
7 files changed, 91 insertions, 16 deletions
@@ -1,21 +1,50 @@ +2011-09-16 Jan Nijtmans <nijtmans@users.sf.net> + + IMPLEMENTATION OF TIP #388 + + * doc/Tcl.n + * doc/re_syntax.n + * generic/regc_lex.c + * generic/regcomp.c + * generic/regcustom.h + * generic/tcl.h + * generic/tclParse.c + * tests/reg.test + * tests/utf.test + +2011-09-16 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tcl.h: Don't change Tcl_UniChar type when + * generic/regcustom.h: TCL_UTF_MAX == 4 (not supported anyway) + +2011-09-16 Donal K. Fellows <dkf@users.sf.net> + + * generic/tclProc.c (ProcWrongNumArgs): [Bugs 3400658,3408830]: + Ensemble-like rewriting of error messages is complex, and TclOO (in + combination with iTcl) hits the most tricky cases. + + * library/http/http.tcl (http::geturl): [Bug 3391977]: Ensure that the + -headers option overrides the -type option (important because -type + has a default that is not always appropriate, and the header must not + be duplicated). + 2011-09-15 Don Porter <dgp@users.sourceforge.net> - * generic/tclCompExpr.c: [Bug 3408408] Partial improvement by - sharing as literals the computed values of constant subexpressions - when we can do so without incurring the cost of string rep - generation. + * generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing + as literals the computed values of constant subexpressions when we can + do so without incurring the cost of string rep generation. 2011-09-13 Don Porter <dgp@users.sourceforge.net> - * generic/tclUtil.c: [Bug 3390638] Workaround broken solaris + * generic/tclUtil.c: [Bug 3390638]: Workaround broken solaris studio cc optimizer. Thanks to Wolfgang S. Kechel. - * generic/tclDTrace.d: [Bug 3405652] Portability workaround for + * generic/tclDTrace.d: [Bug 3405652]: Portability workaround for broken system DTrace support. Thanks to Dagobert Michelson. 2011-09-12 Jan Nijtmans <nijtmans@users.sf.net> - * win/tclWinPort.h: [Bug 3407070] tclPosixStr.c won't build with + * win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with EOVERFLOW==E2BIG 2011-09-11 Don Porter <dgp@users.sourceforge.net> @@ -27,12 +56,6 @@ Thread package use in socket_*-13.1. Eliminates a memory leak in `make valgrind`. -2011-09-10 Donal K. Fellows <dkf@users.sf.net> - - * generic/tclOOMethod.c (InitEnsembleRewrite): [Bug 3400658]: Set the - ensemble-like rewriting up correctly for forwarded methods so that - computed error messages are correct. - 2011-09-09 Don Porter <dgp@users.sourceforge.net> * tests/chanio.test: [Bug 3389733]: Convert [testthread] use to diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 708295a..4e7edb8 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1595,7 +1595,7 @@ InitEnsembleRewrite( if (isRootEnsemble) { iPtr->ensembleRewrite.sourceObjs = objv; iPtr->ensembleRewrite.numRemovedObjs = toRewrite; - iPtr->ensembleRewrite.numInsertedObjs = rewriteLength - 1; + iPtr->ensembleRewrite.numInsertedObjs = rewriteLength; } else { int numIns = iPtr->ensembleRewrite.numInsertedObjs; diff --git a/generic/tclProc.c b/generic/tclProc.c index 50cf0f7..d008217 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1120,6 +1120,8 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { + ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1; + #ifdef AVOID_HACKS_FOR_ITCL desiredObjs[0] = framePtr->objv[skip-1]; #else diff --git a/library/http/http.tcl b/library/http/http.tcl index c636458..69817b8 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -684,6 +684,7 @@ proc http::geturl {url args} { puts $sock "Proxy-Connection: Keep-Alive" } set accept_encoding_seen 0 + set content_type_seen 0 foreach {key value} $state(-headers) { if {[string equal -nocase $key "host"]} { continue @@ -691,6 +692,9 @@ proc http::geturl {url args} { if {[string equal -nocase $key "accept-encoding"]} { set accept_encoding_seen 1 } + if {[string equal -nocase $key "content-type"]} { + set content_type_seen 1 + } set value [string map [list \n "" \r ""] $value] set key [string trim $key] if {[string equal -nocase $key "content-length"]} { @@ -733,7 +737,9 @@ proc http::geturl {url args} { # response. if {$isQuery || $isQueryChannel} { - puts $sock "Content-Type: $state(-type)" + if {!$content_type_seen} { + puts $sock "Content-Type: $state(-type)" + } if {!$contDone} { puts $sock "Content-Length: $state(querylength)" } diff --git a/tests/http.test b/tests/http.test index e6e7649..d9c1efb 100644 --- a/tests/http.test +++ b/tests/http.test @@ -364,6 +364,32 @@ test http-3.26 {http::meta} -setup { http::cleanup $token unset -nocomplain m token } -result {Content-Length Content-Type Date X-Check} +test http-3.27 {http::geturl: -headers override -type} -body { + set token [http::geturl $url/headers -type "text/plain" -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Accept-Encoding .* +Content-Length 5} +test http-3.28 {http::geturl: -headers override -type default} -body { + set token [http::geturl $url/headers -query dummy \ + -headers [list "Content-Type" "text/plain;charset=utf-8"]] + http::data $token +} -cleanup { + http::cleanup $token +} -match regexp -result {(?n)Accept \*/\* +Host .* +User-Agent .* +Connection close +Content-Type {text/plain;charset=utf-8} +Accept-Encoding .* +Content-Length 5} test http-4.1 {http::Event} -body { set token [http::geturl $url -keepalive 0] diff --git a/tests/httpd b/tests/httpd index 5272385..f810797 100644 --- a/tests/httpd +++ b/tests/httpd @@ -175,6 +175,14 @@ proc httpdRespond { sock } { set html "Got [string length $data(query)] bytes" set type text/plain } + *headers* { + set html "" + set type text/plain + foreach {key value} $data(meta) { + append html [list $key $value] "\n" + } + set html [string trim $html] + } default { set type text/html diff --git a/tests/oo.test b/tests/oo.test index 5ec5d2f..e5a17f1 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -863,7 +863,7 @@ test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setu } -result {wrong # args: should be "foo test d"} test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -setup { oo::class create fooClass -} -constraints knownBug -body { +} -body { oo::define fooClass { forward test handler1 foo bar boo forward handler2 my handler @@ -880,6 +880,16 @@ test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -s } -returnCodes error -cleanup { fooClass destroy } -result {wrong # args: should be "foo test c d"} +test oo-6.18 {Bug 3408830: more forwarding cases} -setup { + oo::class create fooClass +} -body { + oo::define fooClass { + forward len string length + } + [fooClass create foo] len a b +} -returnCodes error -cleanup { + fooClass destroy +} -result {wrong # args: should be "::foo len string"} test oo-7.1 {OO: inheritance 101} -setup { oo::class create superClass |