diff options
| author | hypnotoad <yoda@etoyoc.com> | 2014-09-03 21:24:17 (GMT) |
|---|---|---|
| committer | hypnotoad <yoda@etoyoc.com> | 2014-09-03 21:24:17 (GMT) |
| commit | e9cf5184532af00157a7f43eb9c2dc4aa4045b69 (patch) | |
| tree | 74a1c2a4ea1fc7f6ad6bec75b74fe49466a05e3f | |
| parent | 2a0c3c78b87ed2aab28dc3aab3fad25cd91bcdad (diff) | |
| parent | 8d5c986031606a4565659bb82dcbba7ab9ce0186 (diff) | |
| download | tcl-e9cf5184532af00157a7f43eb9c2dc4aa4045b69.zip tcl-e9cf5184532af00157a7f43eb9c2dc4aa4045b69.tar.gz tcl-e9cf5184532af00157a7f43eb9c2dc4aa4045b69.tar.bz2 | |
Merging changes from trunk
| -rw-r--r-- | generic/tclThreadAlloc.c | 3 | ||||
| -rw-r--r-- | tests/aaa_exit.test | 27 |
2 files changed, 22 insertions, 8 deletions
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 5cb8027..560556d 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -217,10 +217,11 @@ GetCache(void) cachePtr = TclpGetAllocCache(); if (cachePtr == NULL) { - cachePtr = calloc(1, sizeof(Cache)); + cachePtr = TclpSysAlloc(sizeof(Cache), 0); if (cachePtr == NULL) { Tcl_Panic("alloc: could not allocate new cache"); } + memset(cachePtr, 0, sizeof(Cache)); Tcl_MutexLock(listLockPtr); cachePtr->nextPtr = firstCachePtr; firstCachePtr = cachePtr; diff --git a/tests/aaa_exit.test b/tests/aaa_exit.test index 51a94d7..3ba5167 100644 --- a/tests/aaa_exit.test +++ b/tests/aaa_exit.test @@ -16,22 +16,35 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } - test exit-1.1 {normal, quick exit} { - set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\" 2>@ stderr" r] - set aft [after 5000 {set done "Quick exit hangs !!!"}] + set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r] + set aft [after 1000 {set done "Quick exit hangs !!!"}] fileevent $f readable {after cancel $aft;set done OK} vwait done - catch {fconfigure $f -blocking 0;close $f} + if {$done != "OK"} { + fconfigure $f -blocking 0 + close $f + } else { + if {[catch {close $f} err]} { + set done "Quick exit misbehaves: $err" + } + } set done } OK test exit-1.2 {full-finalized exit} { - set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\" 2>@ stderr" r] - set aft [after 5000 {set done "Full-finalized exit hangs !!!"}] + set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r] + set aft [after 1000 {set done "Full-finalized exit hangs !!!"}] fileevent $f readable {after cancel $aft;set done OK} vwait done - catch {fconfigure $f -blocking 0;close $f} + if {$done != "OK"} { + fconfigure $f -blocking 0 + close $f + } else { + if {[catch {close $f} err]} { + set done "Full-finalized exit misbehaves: $err" + } + } set done } OK |