From 228bbc8713a27f21735f74e4ed4a4e77c8edf3c7 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 1 Apr 2014 09:52:34 +0000 Subject: Set return message in close if a flush error is reported (which may be an error from a background flush). Ticket [97069ea11a] --- generic/tclIO.c | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index c43e61e..15fc8af 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3209,9 +3209,20 @@ Tcl_Close( Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1)); } - flushcode = -1; + return TCL_ERROR; } - if ((flushcode != 0) || (result != 0)) { + if (result != 0) { + return TCL_ERROR; + } + /* + * Bug 97069ea11a: set error message if a flush code is set + */ + if (flushcode != 0) { + Tcl_SetErrno(flushcode); + if (interp != NULL) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + } return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From e14e7323ec0a1a11668d5ae89f1e4a102e4757b4 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 1 Apr 2014 11:31:49 +0000 Subject: Fix test failure socket-2.9: "1 {not owner}" instead of "1 {couldn't open socket address already in use}" by only setting returned error message if not jet set. --- generic/tclIO.c | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 15fc8af..9e675c6 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -3211,18 +3211,17 @@ Tcl_Close( } return TCL_ERROR; } - if (result != 0) { - return TCL_ERROR; - } /* - * Bug 97069ea11a: set error message if a flush code is set + * Bug 97069ea11a: set error message if a flush code is set and no error + * message set up to now. */ - if (flushcode != 0) { + if (flushcode != 0 && interp != NULL + && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) { Tcl_SetErrno(flushcode); - if (interp != NULL) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj(Tcl_PosixError(interp), -1)); - } + Tcl_SetObjResult(interp, + Tcl_NewStringObj(Tcl_PosixError(interp), -1)); + } + if ((flushcode != 0) || (result != 0)) { return TCL_ERROR; } return TCL_OK; -- cgit v0.12 From a34d5fc9fb803e7cd3b123445f615018c2e1e23c Mon Sep 17 00:00:00 2001 From: max Date: Tue, 1 Apr 2014 12:17:36 +0000 Subject: Add test cases for Bug [97069ea11a]. --- tests/socket.test | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/tests/socket.test b/tests/socket.test index 0ae5abd..5a6d9cd 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -1672,6 +1672,33 @@ test socket-13.1 {Testing use of shared socket between two threads} \ } -cleanup { removeFile script } -result {hello 1} +test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \ + -constraints {socket} \ + -body { + set sock [socket -async 169.254.0.0 42424] + fconfigure $sock -blocking 0 + puts $sock ok + fileevent $sock writable {set x 1} + vwait x + close $sock + } -cleanup { + catch {close $sock} + unset x + } -result {host is unreachable} -returnCodes 1 +test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \ + -constraints {socket} \ + -body { + set sock [socket -async 169.254.0.0 42424] + fconfigure $sock -blocking 0 + puts $sock ok + flush $sock + fileevent $sock writable {set x 1} + vwait x + close $sock + } -cleanup { + catch {close $sock} + catch {unset x} + } -result {host is unreachable} -returnCodes 1 removeFile script1 removeFile script2 -- cgit v0.12 From 8d1bb4056046a74a3f04fa04992d2eb9d7346776 Mon Sep 17 00:00:00 2001 From: max Date: Tue, 1 Apr 2014 14:00:04 +0000 Subject: Centralize and clarify the user of 169.254.0.0 as a non-reachable address. --- tests/socket.test | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 5a6d9cd..9ffe506 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -63,6 +63,12 @@ package require tcltest 2 namespace import -force ::tcltest::* +# For some tests we need an IP address that never responds. +# 169.254.0.0 seems to be a good candidate, because it is from a +# reserved part of the zeroconf address space. Should it ever cause +# any problems, a different known-unreachable adress can be set here. +set unreachableIP 169.254.0.0 + # Some tests require the testthread and exec commands testConstraint testthread [llength [info commands testthread]] testConstraint exec [llength [info commands exec]] @@ -1675,7 +1681,7 @@ test socket-13.1 {Testing use of shared socket between two threads} \ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \ -constraints {socket} \ -body { - set sock [socket -async 169.254.0.0 42424] + set sock [socket -async $unreachableIP 42424] fconfigure $sock -blocking 0 puts $sock ok fileevent $sock writable {set x 1} @@ -1688,7 +1694,7 @@ test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, n test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \ -constraints {socket} \ -body { - set sock [socket -async 169.254.0.0 42424] + set sock [socket -async $unreachableIP 42424] fconfigure $sock -blocking 0 puts $sock ok flush $sock @@ -1697,7 +1703,7 @@ test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, f close $sock } -cleanup { catch {close $sock} - catch {unset x} + unset x } -result {host is unreachable} -returnCodes 1 removeFile script1 -- cgit v0.12 From 3789b7493dc4baf577d118984bde1ea11cbe66e5 Mon Sep 17 00:00:00 2001 From: max Date: Fri, 4 Apr 2014 08:29:51 +0000 Subject: Revert the tests for bug#97069ea11a from socket.test, because it is hard to test with the socket command in a platform-independent way. As the bug is in tclIOChan.c and should be tested there with a dummy channel driver that can reliably reproduce the situation that suppresses the error message. --- tests/socket.test | 33 --------------------------------- 1 file changed, 33 deletions(-) diff --git a/tests/socket.test b/tests/socket.test index 9ffe506..0ae5abd 100644 --- a/tests/socket.test +++ b/tests/socket.test @@ -63,12 +63,6 @@ package require tcltest 2 namespace import -force ::tcltest::* -# For some tests we need an IP address that never responds. -# 169.254.0.0 seems to be a good candidate, because it is from a -# reserved part of the zeroconf address space. Should it ever cause -# any problems, a different known-unreachable adress can be set here. -set unreachableIP 169.254.0.0 - # Some tests require the testthread and exec commands testConstraint testthread [llength [info commands testthread]] testConstraint exec [llength [info commands exec]] @@ -1678,33 +1672,6 @@ test socket-13.1 {Testing use of shared socket between two threads} \ } -cleanup { removeFile script } -result {hello 1} -test socket-14.11.0 {pending [socket -async] and blocking [puts], no listener, no flush} \ - -constraints {socket} \ - -body { - set sock [socket -async $unreachableIP 42424] - fconfigure $sock -blocking 0 - puts $sock ok - fileevent $sock writable {set x 1} - vwait x - close $sock - } -cleanup { - catch {close $sock} - unset x - } -result {host is unreachable} -returnCodes 1 -test socket-14.11.1 {pending [socket -async] and blocking [puts], no listener, flush} \ - -constraints {socket} \ - -body { - set sock [socket -async $unreachableIP 42424] - fconfigure $sock -blocking 0 - puts $sock ok - flush $sock - fileevent $sock writable {set x 1} - vwait x - close $sock - } -cleanup { - catch {close $sock} - unset x - } -result {host is unreachable} -returnCodes 1 removeFile script1 removeFile script2 -- cgit v0.12