From eadd91e0acd18a46a5897e280289e1782a634f4a Mon Sep 17 00:00:00 2001 From: hobbs Date: Fri, 14 Apr 2000 08:34:28 +0000 Subject: * tests/winDialog.test: tk_chooseDirectory seems to get a noop from GetOpenFileName in the static build, hanging some tests. The tests were fixed to timeout (noop cause unknown). * tests/scale.test: correct 17.1 WRT bug 4833 --- tests/scale.test | 8 ++++-- tests/winDialog.test | 71 +++++++++++++++++++++++++--------------------------- 2 files changed, 40 insertions(+), 39 deletions(-) diff --git a/tests/scale.test b/tests/scale.test index 8db85ac..c68bf01 100644 --- a/tests/scale.test +++ b/tests/scale.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: scale.test,v 1.9 1999/12/21 23:55:55 hobbs Exp $ +# RCS: @(#) $Id: scale.test,v 1.10 2000/04/14 08:34:28 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -807,8 +807,12 @@ test scale-17.1 {bug fix 1786} { pack .s update .s configure -variable x ;# CRASH! -> Floating point exception + + # Bug 4833 changed the result to realize that x should pick up + # a value from the scale. In an FPE occurs, it is due to the + # lack of errno being set to 0 by some libc's. (see bug 4942) set x -} {} +} {100} test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} { catch {destroy .s} diff --git a/tests/winDialog.test b/tests/winDialog.test index 7116fee..15b491f 100644 --- a/tests/winDialog.test +++ b/tests/winDialog.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: winDialog.test,v 1.3 2000/04/08 06:59:37 hobbs Exp $ +# RCS: @(#) $Id: winDialog.test,v 1.4 2000/04/14 08:34:28 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -26,8 +26,9 @@ raise . proc start {arg} { set ::tk_dialog 0 + set ::iter_after 0 - after 1 "$arg" + after 1 $arg } proc then {cmd} { @@ -41,6 +42,10 @@ proc then {cmd} { proc afterbody {} { if {$::tk_dialog == 0} { + if {[incr ::iter_after] > 30} { + set ::dialogresult ">30 iterations waiting on tk_dialog" + return + } after 100 {afterbody} return } @@ -72,7 +77,7 @@ test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} { set x [GetText 2] Click 2 } - set x + set x } {Cancel} test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { @@ -81,7 +86,7 @@ test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} { set x [GetText 2] Click 2 } - set x + set x } {Cancel} test winDialog-5.1 {GetFileName: no arguments} {nt} { @@ -242,7 +247,7 @@ test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} { } set x } {&Open} -test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} { +test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt} { # winCode = GetSaveFileName(&ofn); start {tk_getSaveFile -title Save} @@ -252,7 +257,7 @@ test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} { } set x } {&Save} -test winDialog-5.22 {GetFileName: convert \ to /} {nt} { +test winDialog-5.24 {GetFileName: convert \ to /} {nt} { start {set x [tk_getSaveFile -title Back]} then { SetText 0x480 "c:\\12x 457" @@ -261,43 +266,49 @@ test winDialog-5.22 {GetFileName: convert \ to /} {nt} { set x } {c:/12x 457} -test winDialog-8.1 {OFNHookProc} {nt} { -} {} +test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {} -test winDialog-6.1 {MakeFilter} {nt} { -} {} +test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} + +test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {} -test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { +## The Tk_ChooseDirectoryObjCmd hang on the static build of Windows +## because somehow the GetOpenFileName ends up a noop in the static +## build. +## +test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} { start {tk_chooseDirectory} then { Click cancel } } {0} -test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { +test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} { list [catch {tk_chooseDirectory -foo} msg] $msg } {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} -test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} { - start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test} +test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} { + start { + tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test + } then { Click cancel } } {0} -test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \ - {nt} { +test winDialog-9.4 {Tk_ChooseDirectoryObjCmd:\ + Tcl_GetIndexFromObj() != TCL_OK} {nt} { list [catch {tk_chooseDirectory -foo bar -abc} msg] $msg } {1 {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}} -test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \ - {nt} { +test winDialog-9.5 {Tk_ChooseDirectoryObjCmd:\ + Tcl_GetIndexFromObj() == TCL_OK} {nt} { start {tk_chooseDirectory -title bar} then { Click cancel } } {0} -test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \ - {nt} { +test winDialog-9.6 {Tk_ChooseDirectoryObjCmd:\ + valid option, but missing value} {nt} { list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg } {1 {value for "-title" missing}} -test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} { +test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt} { # case DIR_INITIAL: start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]} @@ -306,30 +317,16 @@ test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} { } string tolower [set x] } {c:/} -test winDialog-5.13 \ - {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \ - {nt} { +test winDialog-9.8 {Tk_ChooseDirectoryObjCmd:\ + initial directory: Tcl_TranslateFilename()} {nt} { # if (Tcl_TranslateFileName(interp, string, # &utfDirString) == NULL) list [catch {tk_chooseDirectory -initialdir ~12x/455} msg] $msg } {1 {user "12x" doesn't exist}} -test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {} - testwinevent debug 0 # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - -- cgit v0.12