diff options
| -rw-r--r-- | generic/tclCmdIL.c | 7 | ||||
| -rw-r--r-- | tests/cmdAH.test | 20 | ||||
| -rw-r--r-- | tests/info.test | 12 |
3 files changed, 35 insertions, 4 deletions
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 40ae998..7f17e4f 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -1147,9 +1147,9 @@ InfoFrameCmd( } corPtr = corPtr->callerEEPtr->corPtr; } - topLevel += (*cmdFramePtrPtr)->level; + topLevel += *cmdFramePtrPtr ? (*cmdFramePtrPtr)->level : 1; - if (topLevel != iPtr->cmdFramePtr->level) { + if (iPtr->cmdFramePtr && topLevel != iPtr->cmdFramePtr->level) { framePtr = iPtr->cmdFramePtr; while (framePtr) { framePtr->level = topLevel--; @@ -1198,6 +1198,9 @@ InfoFrameCmd( } framePtr = iPtr->cmdFramePtr; + if (!framePtr) { + goto levelError; + } while (++level <= 0) { framePtr = framePtr->nextPtr; if (!framePtr) { diff --git a/tests/cmdAH.test b/tests/cmdAH.test index 6432ad4..14ec234 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -26,6 +26,22 @@ testConstraint time64bit [expr { ([llength [info command testsize]] ? [testsize st_mtime] : $::tcl_platform(pointerSize)) >= 8 }] +testConstraint filetime64bit [expr { + [testConstraint time64bit] && ( + ![testConstraint unix] || [apply {{} { + # check whether disk may have 2038 problem, see [fd91b0ca09cb171f]: + set fn [makeFile "" foo.text] + if {[catch { + exec sh -c "TZ=:UTC LC_TYME=en_US touch -ma -t '207006290000' '$fn' && TZ=:UTC LC_TYME=en_US ls -l '$fn'" + } res]} { + #puts "Check constraint failed:\t$res" + set res {} + } + removeFile $fn + regexp {\mJun\s+29\s+2070\M} $res + }}] + ) +}] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 @@ -1724,14 +1740,14 @@ test cmdAH-24.14.1 { } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070: -test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { +test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit filetime64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file atime $filename 3155760000] [file atime $filename] } -cleanup { removeFile $filename } -result {3155760000 3155760000} -test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { +test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit filetime64bit} -setup { set filename [makeFile "" foo.text] } -body { list [file mtime $filename 3155760000] [file mtime $filename] diff --git a/tests/info.test b/tests/info.test index ef41bdf..ea03f52 100644 --- a/tests/info.test +++ b/tests/info.test @@ -2583,6 +2583,18 @@ test info-39.2 {Bug 4b61afd660} -setup { rename probe {} } -result 3 +test info-40.0 {Bug 0de6c1d79c crash} -setup { + interp create child + child hide info +} -body { + list [child invokehidden info frame] \ + [catch {child invokehidden info frame 0} msg] $msg \ + [catch {child invokehidden info frame 1} msg] $msg +} -cleanup { + interp delete child + unset -nocomplain msg +} -result {1 1 {bad level "0"} 1 {bad level "1"}} + # cleanup catch {namespace delete test_ns_info1 test_ns_info2} ::tcltest::cleanupTests |