diff options
author | sebres <sebres@users.sourceforge.net> | 2017-07-10 11:31:03 (GMT) |
---|---|---|
committer | sebres <sebres@users.sourceforge.net> | 2017-07-10 11:31:03 (GMT) |
commit | ce2632231521ea73edf746feb8440d55299fd816 (patch) | |
tree | 325b6dcdd9fd437611656cb8bfcc88723b4832b1 /library | |
parent | 10c4411b959259a23acf9d979fe3faf06d177288 (diff) | |
parent | daaac6f4c23110b1489e943f514c4b8befc14b2d (diff) | |
download | tcl-ce2632231521ea73edf746feb8440d55299fd816.zip tcl-ce2632231521ea73edf746feb8440d55299fd816.tar.gz tcl-ce2632231521ea73edf746feb8440d55299fd816.tar.bz2 |
merge core-8-6-branch
Diffstat (limited to 'library')
-rw-r--r-- | library/http/http.tcl | 2 | ||||
-rw-r--r-- | library/init.tcl | 50 |
2 files changed, 29 insertions, 23 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index d950441..0350808 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -206,7 +206,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} { set state(error) [list $errormsg $errorInfo $errorCode] set state(status) "error" } - if { ($state(status) eq "timeout") + if { ($state(status) eq "timeout") || ($state(status) eq "error") || ([info exists state(-keepalive)] && !$state(-keepalive)) || ([info exists state(connection)] && ($state(connection) eq "close")) diff --git a/library/init.tcl b/library/init.tcl index a202054..6173b86 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -284,14 +284,9 @@ proc unknown args { } append cinfo ... } - append cinfo "\"\n (\"uplevel\" body line 1)" - append cinfo "\n invoked from within" - append cinfo "\n\"uplevel 1 \$args\"" - # - # Try each possible form of the stack trace - # and trim the extra contribution from the matching case - # - set expect "$msg\n while executing\n\"$cinfo" + set tail "\n (\"uplevel\" body line 1)\n invoked\ + from within\n\"uplevel 1 \$args\"" + set expect "$msg\n while executing\n\"$cinfo\"$tail" if {$errInfo eq $expect} { # # The stack has only the eval from the expanded command @@ -305,21 +300,32 @@ proc unknown args { # Stack trace is nested, trim off just the contribution # from the extra "eval" of $args due to the "catch" above. # - set expect "\n invoked from within\n\"$cinfo" - set exlen [string length $expect] - set eilen [string length $errInfo] - set i [expr {$eilen - $exlen - 1}] - set einfo [string range $errInfo 0 $i] - # - # For now verify that $errInfo consists of what we are about - # to return plus what we expected to trim off. - # - if {$errInfo ne "$einfo$expect"} { - error "Tcl bug: unexpected stack trace in \"unknown\"" {} \ - [list CORE UNKNOWN BADTRACE $einfo $expect $errInfo] + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + # Very likely cannot happen + return -options $opts $msg } - return -code error -errorcode $errCode \ - -errorinfo $einfo $msg + set errInfo [string range $errInfo 0 $last-1] + set tail "\"$cinfo\"" + set last [string last $tail $errInfo] + if {$last + [string length $tail] != [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo $errInfo $msg + } + set errInfo [string range $errInfo 0 $last-1] + set tail "\n invoked from within\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + set tail "\n while executing\n" + set last [string last $tail $errInfo] + if {$last + [string length $tail] == [string length $errInfo]} { + return -code error -errorcode $errCode \ + -errorinfo [string range $errInfo 0 $last-1] $msg + } + return -options $opts $msg } else { dict incr opts -level return -options $opts $msg |