From 6cbfb973fe310b73c224da9596b24e61a99fa2bb Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 8 Apr 2015 14:37:58 +0000
Subject: Proposed fix.

---
 generic/tclExecute.c | 1 +
 1 file changed, 1 insertion(+)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f2f475a..feff85b 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4946,6 +4946,7 @@ TEBCresume(
 	pc += pcAdjustment;
 	TEBC_YIELD();
 
+	TclMarkTailcall(interp);
 	oPtr = contextPtr->oPtr;
 	if (oPtr->flags & FILTER_HANDLING) {
 	    TclNRAddCallback(interp, FinalizeOONextFilter,
-- 
cgit v0.12


From 3b49d1ae60676917334358e87bf1e9766502d4c7 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 8 Apr 2015 16:42:33 +0000
Subject: Correction suggested by miguel.  Passes test suite and fixes bug
 demos.

---
 generic/tclExecute.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index feff85b..43c2b08 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4946,7 +4946,7 @@ TEBCresume(
 	pc += pcAdjustment;
 	TEBC_YIELD();
 
-	TclMarkTailcall(interp);
+	TclPushTailcallPoint(interp);
 	oPtr = contextPtr->oPtr;
 	if (oPtr->flags & FILTER_HANDLING) {
 	    TclNRAddCallback(interp, FinalizeOONextFilter,
-- 
cgit v0.12


From 63dc775eaa7f684960382acb12c369743697c698 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 12 May 2015 15:00:16 +0000
Subject: Added contributed tests from aspect

---
 tests/ooNext2.test | 195 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 195 insertions(+)

diff --git a/tests/ooNext2.test b/tests/ooNext2.test
index 5ecd209..6c4f1ad 100644
--- a/tests/ooNext2.test
+++ b/tests/ooNext2.test
@@ -866,6 +866,201 @@ test oo-call-3.4 {current call introspection: in destructors} -setup {
 } -cleanup {
     root destroy
 } -result {{{{method <destructor> ::B method} {method <destructor> ::A method}} 0} {{{method <destructor> ::B method} {method <destructor> ::A method}} 1}}
+
+# Contributed tests from aspect, related to [0f42ff7871]
+#
+# dkf's "Principles Leading to a Fix"
+#
+#   A method ought to work "the same" whether or not it has been overridden by
+#   a subclass. A tailcalled command ought to have as parent stack the same
+#   thing you'd get with uplevel 1. A subclass will often expect the
+#   superclass's result to be the result that would be returned if the subclass
+#   was not there. 
+#
+
+# common setup:
+#  any invocation of bar should emit "abc\nhi\n" then return to its caller
+set testopts {
+    -setup {
+        oo::class create Foo {
+            method bar {} {
+                puts abc
+                tailcall puts hi
+                puts xyz
+            }
+        }
+    }
+    -cleanup {
+        catch {Foo destroy}
+        catch {Foo2 destroy}    ;# created by some tests
+    }
+}
+
+# these succeed, showing that without [next] the bug doesn't fire
+test next-tailcall-simple-1 "trivial case with one method" {*}$testopts -body {
+    [Foo create foo] bar
+} -output [join {abc hi} \n]\n
+
+test next-tailcall-simple-2 "my bar" {*}$testopts -body {
+    oo::define Foo method baz {} {
+        puts a
+        my bar
+        puts b
+    }
+    [Foo create foo] baz
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-simple-3 "\[self\] bar" {*}$testopts -body {
+    oo::define Foo method baz {} {
+        puts a
+        [self] bar
+        puts b
+    }
+    [Foo create foo] baz
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-simple-4 "foo bar" {*}$testopts -body {
+    oo::define Foo method baz {} {
+        puts a
+        foo bar
+        puts b
+    }
+    [Foo create foo] baz
+} -output [join {a abc hi b} \n]\n
+
+# everything from here on uses [next], and fails on 8.6.4 with compilation
+test next-tailcall-superclass-1 "next superclass" {*}$testopts -body {
+    oo::class create Foo2 {
+        superclass Foo
+        method bar {} {
+            puts a
+            next
+            puts b
+        }
+    }
+    [Foo2 create foo] bar
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-superclass-2 "nextto superclass" {*}$testopts -body {
+    oo::class create Foo2 {
+        superclass Foo
+        method bar {} {
+            puts a
+            nextto Foo
+            puts b
+        }
+    }
+    [Foo2 create foo] bar
+} -output [join {a abc hi b} \n]\n
+
+
+test next-tailcall-mixin-1 "class mixin" {*}$testopts -body {
+    oo::class create Foo2 {
+        method Bar {} {
+            puts a
+            next
+            puts b
+        }
+        filter Bar
+    }
+    oo::define Foo mixin Foo2
+    Foo create foo
+    foo bar
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-objmixin-1 "object mixin" {*}$testopts -body {
+    oo::class create Foo2 {
+        method Bar {} {
+            puts a
+            next
+            puts b
+        }
+        filter Bar
+    }
+    Foo create foo
+    oo::objdefine foo mixin Foo2
+    foo bar
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-filter-1 "filter method" {*}$testopts -body {
+    oo::define Foo method Filter {} {
+        puts a
+        next
+        puts b
+    }
+    oo::define Foo filter Filter
+    [Foo new] bar
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-forward-1 "forward method" {*}$testopts -body {
+    proc foobar {} {
+        puts "abc"
+        tailcall puts "hi"
+        puts "xyz"
+    }
+    oo::define Foo forward foobar foobar
+    oo::class create Foo2 {
+        superclass Foo
+        method foobar {} {
+            puts a
+            next
+            puts b
+        }
+    }
+    [Foo2 new] foobar
+} -output [join {a abc hi b} \n]\n
+
+test next-tailcall-constructor-1 "next in constructor" -body {
+    oo::class create Foo {
+        constructor {} {
+            puts abc
+            tailcall puts hi
+            puts xyz
+        }
+    }
+    oo::class create Foo2 {
+        superclass Foo
+        constructor {} {
+            puts a
+            next
+            puts b
+        }
+    }
+    list [Foo new] [Foo2 new]
+    return ""
+} -cleanup {
+    Foo destroy
+} -output [join {abc hi a abc hi b} \n]\n
+
+
+test next-tailcall-destructor-1 "next in destructor" -body {
+    oo::class create Foo {
+        destructor {
+            puts abc
+            tailcall puts hi
+            puts xyz
+        }
+    }
+    oo::class create Foo2 {
+        superclass Foo
+        destructor {
+            puts a
+            next
+            puts b
+        }
+    }
+    Foo  create foo
+    Foo2 create foo2
+    foo destroy
+    foo2 destroy
+} -output [join {abc hi a abc hi b} \n]\n
+
+
+
+
+unset testopts
+
+
 
 cleanupTests
 return
-- 
cgit v0.12


From e333cabdeec6802bacdab621d6567618954581e6 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 14 May 2015 08:05:37 +0000
Subject: [b9d0434667] Prefer the gzip encoding for transfers. It's less
 efficient, but it is far more interoperable and that's a more important
 metric.

---
 library/http/http.tcl |  2 +-
 tests/http11.test     | 33 ++++++++++++++++++++++++++-------
 tests/httpd11.tcl     | 15 ++++++++-------
 3 files changed, 35 insertions(+), 15 deletions(-)

diff --git a/library/http/http.tcl b/library/http/http.tcl
index a6b2bfd..4870f4a 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -739,7 +739,7 @@ proc http::Connected { token proto phost srvurl} {
 	    }
 	}
         if {!$accept_encoding_seen && ![info exists state(-handler)]} {
-	    puts $sock "Accept-Encoding: deflate,gzip,compress"
+	    puts $sock "Accept-Encoding: gzip,deflate,compress"
         }
 	if {$isQueryChannel && $state(querylength) == 0} {
 	    # Try to determine size of data in channel. If we cannot seek, the
diff --git a/tests/http11.test b/tests/http11.test
index 230ce5a..c9ded0b 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -70,11 +70,8 @@ proc check_crc {tok args} {
     return "ok"
 }
 
-makeFile "<html><head><title>test</title></head>\
-<body><p>this is a test</p>\n\
-[string repeat {<p>This is a tcl test file.</p>} 4192]\n\
-</body></html>" testdoc.html
-
+makeFile "<html><head><title>test</title></head><body><p>this is a test</p>\n[string repeat {<p>This is a tcl test file.</p>} 4192]\n</body></html>" testdoc.html
+
 # -------------------------------------------------------------------------
 
 test http11-1.0 "normal request for document " -setup {
@@ -447,7 +444,8 @@ test http11-2.10 "-channel,deflate,keepalive" -setup {
     set chan [open [makeFile {} testfile.tmp] wb+]
 } -body {
     set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
-                 -timeout 5000 -channel $chan -keepalive 1]
+                 -timeout 5000 -channel $chan -keepalive 1 \
+		 -headers {accept-encoding deflate}]
     http::wait $tok
     seek $chan 0
     set data [read $chan]
@@ -482,6 +480,27 @@ test http11-2.11 "-channel,identity,keepalive" -setup {
     halt_httpd
 } -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}
 
+test http11-2.12 "-channel,negotiate,keepalive" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan -keepalive 1]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding] [meta $tok x-requested-encodings]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} gzip chunked gzip,deflate,compress 0}
+
+
 # -------------------------------------------------------------------------
 #
 # The following tests for the -handler option will require changes in
@@ -644,7 +663,7 @@ test http11-4.3 "normal post request, check channel query length" -setup {
     removeFile testfile.tmp
     halt_httpd
 } -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}
-
+
 # -------------------------------------------------------------------------
 
 foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
index 9c543dc..267f409 100644
--- a/tests/httpd11.tcl
+++ b/tests/httpd11.tcl
@@ -158,13 +158,13 @@ proc Service {chan addr port} {
         }
         
         if {$protocol eq "HTTP/1.1"} {
-            if {[string match "*deflate*" [dict get? $meta accept-encoding]]} {
-                set encoding deflate
-            } elseif {[string match "*gzip*" [dict get? $meta accept-encoding]]} {
-                set encoding gzip
-            } elseif {[string match "*compress*" [dict get? $meta accept-encoding]]} {
-                set encoding compress
-            }
+	    foreach enc [split [dict get? $meta accept-encoding] ,] {
+		set enc [string trim $enc]
+		if {$enc in {deflate gzip compress}} {
+		    set encoding $enc
+		    break
+		}
+	    }
             set transfer chunked
         } else {
             set close 1
@@ -189,6 +189,7 @@ proc Service {chan addr port} {
         if {$close} {
             Puts $chan "connection: close"
         }
+	Puts $chan "x-requested-encodings: [dict get? $meta accept-encoding]"
         if {$encoding eq "identity"} {
             Puts $chan "content-length: [string length $data]"
         } else {
-- 
cgit v0.12


From cc2a1eebc7d77d09180ccb2cfa7aca40d981bda8 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Thu, 14 May 2015 08:23:52 +0000
Subject: [6a71dbe6ec] Ensure that compression errors log correctly.

---
 library/http/http.tcl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/library/http/http.tcl b/library/http/http.tcl
index 4870f4a..97f6348 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -1299,7 +1299,7 @@ proc http::Eof {token {force 0}} {
 		set state(body) [zlib $coding $state(body)]
 	    }
 	} err]} {
-	    Log "error doing $coding '$state(body)'"
+	    Log "error doing decompression: $err"
 	    return [Finish $token $err]
 	}
 
-- 
cgit v0.12


From 0785ac4c8918cc64f8298aee9629017fc17ba86c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 14 May 2015 11:19:27 +0000
Subject: Bump to http 2.8.9

---
 library/http/http.tcl     | 2 +-
 library/http/pkgIndex.tcl | 2 +-
 unix/Makefile.in          | 4 ++--
 win/Makefile.in           | 4 ++--
 4 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/library/http/http.tcl b/library/http/http.tcl
index 97f6348..751ca13 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
 package require Tcl 8.6
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.8.8
+package provide http 2.8.9
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 27ba795..6e0301a 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
 if {![package vsatisfies [package provide Tcl] 8.6]} {return}
-package ifneeded http 2.8.8 [list tclPkgSetup $dir http 2.8.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.8.9 [list tclPkgSetup $dir http 2.8.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 46ff5cd..958e759 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -844,8 +844,8 @@ install-libraries: libraries
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
 	    done;
-	@echo "Installing package http 2.8.8 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.8.tm;
+	@echo "Installing package http 2.8.9 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.9.tm;
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
diff --git a/win/Makefile.in b/win/Makefile.in
index 71d3fe6..168da2e 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -643,8 +643,8 @@ install-libraries: libraries install-tzdata install-msgs
 	    do \
 	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
 	    done;
-	@echo "Installing package http 2.8.8 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.8.tm;
+	@echo "Installing package http 2.8.9 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.9.tm;
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \
-- 
cgit v0.12


From d52ef74d40e9ea437e953e3f7d5ea021324b3b9e Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 15 May 2015 13:54:52 +0000
Subject: [9dd1bd7a74] Ensure that [self] returns a sensible value in a
 destructor even when construction didn't complete.

---
 generic/tclOO.c |  9 +++++++--
 tests/oo.test   | 25 +++++++++++++++++++++++++
 2 files changed, 32 insertions(+), 2 deletions(-)

diff --git a/generic/tclOO.c b/generic/tclOO.c
index 77e668b..e2ef1ae 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1675,10 +1675,13 @@ Tcl_NewObjectInstance(
 
 		/*
 		 * Take care to not delete a deleted object; that would be
-		 * bad. [Bug 2903011]
+		 * bad. [Bug 2903011] Also take care to make sure that we have
+		 * the name of the command before we delete it. [Bug
+		 * 9dd1bd7a74]
 		 */
 
 		if (!Deleted(oPtr)) {
+		    (void) TclOOObjectName(interp, oPtr);
 		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 		}
 		return NULL;
@@ -1821,10 +1824,12 @@ FinalizeAlloc(
 
 	/*
 	 * Take care to not delete a deleted object; that would be bad. [Bug
-	 * 2903011]
+	 * 2903011] Also take care to make sure that we have the name of the
+	 * command before we delete it. [Bug 9dd1bd7a74]
 	 */
 
 	if (!Deleted(oPtr)) {
+	    (void) TclOOObjectName(interp, oPtr);
 	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
 	}
 	DelRef(oPtr);
diff --git a/tests/oo.test b/tests/oo.test
index 5fa760b..22e6cfb 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -416,6 +416,31 @@ test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
 } -returnCodes error -cleanup {
     namespace delete k
 } -result {wrong # args: should be "k next j"}
+test oo-2.9 {construction failures and self creation} -setup {
+    set ::result {}
+    oo::class create Root
+} -body {
+    oo::class create A {
+	superclass Root
+	constructor {} {
+	    lappend ::result "in A"
+	    error "failure in A"
+	}
+	destructor {lappend ::result [self]}
+    }
+    oo::class create B {
+	superclass Root
+	constructor {} {
+	    lappend ::result "in B [self]"
+	    error "failure in B"
+	}
+	destructor {lappend ::result [self]}
+    }
+    lappend ::result [catch {A create a} msg] $msg
+    lappend ::result [catch {B create b} msg] $msg
+} -cleanup {
+    Root destroy
+} -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}}
 
 test oo-3.1 {basic test of OO functionality: destructor} -setup {
     # This is a bit complex because it needs to run in a sub-interp as we're
-- 
cgit v0.12


From 8dbd1a22e6d1fa309234b477a35d4e52cedb6042 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 17 May 2015 12:06:31 +0000
Subject: [ad6696285c] Demonstrate that filters are not called for destructors.

---
 tests/oo.test | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/tests/oo.test b/tests/oo.test
index 22e6cfb..f35b70a 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1569,6 +1569,34 @@ test oo-12.7 {OO: filters} -setup {
 } -cleanup {
     Aclass destroy
 } -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
+test oo-12.8 {OO: filters and destructors} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+    set ::log {}
+} -body {
+    oo::define Aclass {
+	constructor {} {
+	    lappend ::log "in constructor"
+	}
+	destructor {
+	    lappend ::log "in destructor"
+	}
+	method bar {} {
+	    lappend ::log "in method"
+	}
+	method Boo args {
+	    lappend ::log [self target]
+	    next {*}$args
+	}
+	filter Boo
+    }
+    set obj [Aclass new]
+    $obj bar
+    $obj destroy
+    return $::log
+} -cleanup {
+    Aclass destroy
+} -result {{in constructor} {::Aclass bar} {in method} {::oo::object destroy} {in destructor}}
 
 test oo-13.1 {OO: changing an object's class} {
     oo::class create Aclass
-- 
cgit v0.12


From 25217a3ed35a8e8d7a9b5fd1c79a84ffbca0164b Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 17 May 2015 12:56:06 +0000
Subject: [ad6696285c] Correction of description of filter behaviour with
 'unknown'.

---
 doc/next.n | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/doc/next.n b/doc/next.n
index 7dacac2..1ea6eb9 100644
--- a/doc/next.n
+++ b/doc/next.n
@@ -96,9 +96,11 @@ forward to the proper implementation of the method (which it does by invoking
 the \fBnext\fR command as filters are inserted into the front of the method
 call chain) and is responsible for returning the result of \fBnext\fR.
 .PP
-Filters are not invoked when processing an invocation of the \fBunknown\fR
-method because of a failure to locate a method implementation, or when
-invoking either constructors or destructors.
+Filters are invoked when processing an invokation of the \fBunknown\fR
+method because of a failure to locate a method implementation, but \fInot\fR
+when invoking either constructors or destructors. (Note however that the
+\fBdestroy\fR method is a conventional method, and filters are invoked as
+normal when it is called.)
 .SH EXAMPLES
 .PP
 This example demonstrates how to use the \fBnext\fR command to call the
-- 
cgit v0.12


From 2e99b7a586017eebeb59276838104929ed1e2d23 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 18 May 2015 07:51:54 +0000
Subject: [c11a51c482] Stop race condition with -accept config option, and
 allow overriding of it via -headers option.

---
 library/http/http.tcl | 41 +++++++++++++++++++++++++++++++----------
 tests/http.test       | 24 +++++++++++++++++++-----
 2 files changed, 50 insertions(+), 15 deletions(-)

diff --git a/library/http/http.tcl b/library/http/http.tcl
index 751ca13..5a05fa0 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -566,6 +566,10 @@ proc http::geturl {url args} {
     # Proxy connections aren't shared among different hosts.
     set state(socketinfo) $host:$port
 
+    # Save the accept types at this point to prevent a race condition. [Bug
+    # c11a51c482]
+    set state(accept-types) $http(-accept)
+
     # See if we are supposed to use a previously opened channel.
     if {$state(-keepalive)} {
 	variable socketmap
@@ -637,8 +641,20 @@ proc http::geturl {url args} {
     return $token
 }
 
+# http::Connected --
+#
+#	Callback used when the connection to the HTTP server is actually
+#	established.
+#
+# Arguments:
+#       token	State token.
+#       proto	What protocol (http, https, etc.) was used to connect.
+#	phost	Are we using keep-alive? Non-empty if yes.
+#	srvurl	Service-local URL that we're requesting
+# Results:
+#	None.
 
-proc http::Connected { token proto phost srvurl} {
+proc http::Connected {token proto phost srvurl} {
     variable http
     variable urlTypes
 
@@ -691,13 +707,12 @@ proc http::Connected { token proto phost srvurl} {
     if {[info exists state(-handler)]} {
 	set state(-protocol) 1.0
     }
+    set accept_types_seen 0
     if {[catch {
 	puts $sock "$how $srvurl HTTP/$state(-protocol)"
-	puts $sock "Accept: $http(-accept)"
-	array set hdrs $state(-headers)
-	if {[info exists hdrs(Host)]} {
+	if {[dict exists $state(-headers) Host]} {
 	    # Allow Host spoofing. [Bug 928154]
-	    puts $sock "Host: $hdrs(Host)"
+	    puts $sock "Host: [dict get $state(-headers) Host]"
 	} elseif {$port == $defport} {
 	    # Don't add port in this case, to handle broken servers. [Bug
 	    # #504508]
@@ -705,7 +720,6 @@ proc http::Connected { token proto phost srvurl} {
 	} else {
 	    puts $sock "Host: $host:$port"
 	}
-	unset hdrs
 	puts $sock "User-Agent: $http(-useragent)"
         if {$state(-protocol) == 1.0 && $state(-keepalive)} {
 	    puts $sock "Connection: keep-alive"
@@ -718,18 +732,21 @@ proc http::Connected { token proto phost srvurl} {
         }
         set accept_encoding_seen 0
 	set content_type_seen 0
-	foreach {key value} $state(-headers) {
+	dict for {key value} $state(-headers) {
+	    set value [string map [list \n "" \r ""] $value]
+	    set key [string map {" " -} [string trim $key]]
 	    if {[string equal -nocase $key "host"]} {
 		continue
 	    }
 	    if {[string equal -nocase $key "accept-encoding"]} {
 		set accept_encoding_seen 1
 	    }
+	    if {[string equal -nocase $key "accept"]} {
+		set accept_types_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"]} {
 		set contDone 1
 		set state(querylength) $value
@@ -738,6 +755,11 @@ proc http::Connected { token proto phost srvurl} {
 		puts $sock "$key: $value"
 	    }
 	}
+	# Allow overriding the Accept header on a per-connection basis. Useful
+	# for working with REST services. [Bug c11a51c482]
+	if {!$accept_types_seen} {
+	    puts $sock "Accept: $state(accept-types)"
+	}
         if {!$accept_encoding_seen && ![info exists state(-handler)]} {
 	    puts $sock "Accept-Encoding: gzip,deflate,compress"
         }
@@ -795,7 +817,6 @@ proc http::Connected { token proto phost srvurl} {
 	    Finish $token $err
 	}
     }
-
 }
 
 # Data access functions:
diff --git a/tests/http.test b/tests/http.test
index a0a26de..41820cb 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -306,7 +306,6 @@ test http-3.13 {http::geturl socket leak test} {
     for {set i 0} {$i < 3} {incr i} {
 	catch {http::geturl $badurl -timeout 5000}
     }
-
     # No extra channels should be taken
     expr {[llength [file channels]] == $chanCount}
 } 1
@@ -372,11 +371,11 @@ test http-3.27 {http::geturl: -headers override -type} -body {
     http::data $token
 } -cleanup {
     http::cleanup $token
-} -match regexp -result {(?n)Accept \*/\*
-Host .*
+} -match regexp -result {(?n)Host .*
 User-Agent .*
 Connection close
 Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
 Accept-Encoding .*
 Content-Length 5}
 test http-3.28 {http::geturl: -headers override -type default} -body {
@@ -385,11 +384,11 @@ test http-3.28 {http::geturl: -headers override -type default} -body {
     http::data $token
 } -cleanup {
     http::cleanup $token
-} -match regexp -result {(?n)Accept \*/\*
-Host .*
+} -match regexp -result {(?n)Host .*
 User-Agent .*
 Connection close
 Content-Type {text/plain;charset=utf-8}
+Accept \*/\*
 Accept-Encoding .*
 Content-Length 5}
 test http-3.29 {http::geturl IPv6 address} -body {
@@ -418,6 +417,21 @@ test http-3.31 {http::geturl fragment without path} -body {
 } -cleanup {
     catch { http::cleanup $token }
 } -result 200
+# Bug c11a51c482
+test http-3.32 {http::geturl: -headers override -accept default} -body {
+    set token [http::geturl $url/headers -query dummy \
+	    -headers [list "Accept" "text/plain,application/tcl-test-value"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Host .*
+User-Agent .*
+Connection close
+Accept text/plain,application/tcl-test-value
+Accept-Encoding .*
+Content-Type application/x-www-form-urlencoded
+Content-Length 5}
+
 test http-4.1 {http::Event} -body {
     set token [http::geturl $url -keepalive 0]
     upvar #0 $token data
-- 
cgit v0.12


From f2aa46953cedd6fe3b80766c84fb9720ae37f771 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 18 May 2015 08:20:43 +0000
Subject: [11250a236d] Made the documentation of non-greediness overrides more
 obvious.

---
 doc/re_syntax.n | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index 46a180d..7988071 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -683,9 +683,33 @@ earlier in the RE taking priority over ones starting later. Note that
 outer subexpressions thus take priority over their component
 subexpressions.
 .PP
-Note that the quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
+The quantifiers \fB{1,1}\fR and \fB{1,1}?\fR can be used to
 force longest and shortest preference, respectively, on a
 subexpression or a whole RE.
+.RS
+.PP
+\fBNOTE:\fR This means that you can usually make a RE be non-greedy overall by
+putting \fB{1,1}?\fR after one of the first non-constraint atoms or
+parenthesized sub-expressions in it. \fIIt pays to experiment\fR with the
+placing of this non-greediness override on a suitable range of input texts
+when you are writing a RE if you are using this level of complexity.
+.PP
+For example, this regular expression is non-greedy, and will match the
+shortest substring possible given that
+.QW \fBabc\fR
+will be matched as early as possible (the quantifier does not change that):
+.PP
+.CS
+ab{1,1}?c.*x.*cba
+.CE
+.PP
+The atom
+.QW \fBa\fR
+has no greediness preference, we explicitly give one for
+.QW \fBb\fR ,
+and the remaining quantifiers are overridden to be non-greedy by the preceding
+non-greedy quantifier.
+.RE
 .PP
 Match lengths are measured in characters, not collating elements. An
 empty string is considered longer than no match at all. For example,
-- 
cgit v0.12