head	1.26;
access;
symbols
	core-8-5-9:1.15.2.3
	core-8-5-8:1.15.2.2
	macosx-cocoa-merge:1.25
	macosx-cocoa-premerge:1.25
	macosx-carbon-freeze:1.25
	core-8-5-7:1.15.2.2
	core-8-5-6:1.15.2.2
	core-8-6-b1:1.25
	core-8-6-a3:1.21
	core-8-5-5:1.15.2.1
	core-8-6-a2:1.17
	core-8-5-4:1.15.2.1
	core-8-5-3:1.15.2.1
	core-8-6-a1:1.17
	core-8-4-19:1.9
	core-8-5-branch:1.15.0.2
	core-8-5-2:1.15
	core-8-4-18:1.9
	core-8-5-1:1.15
	core-8-4-17:1.9
	core-8-5-0:1.15
	core-8-5-b3:1.14
	core-8-5-b2:1.14
	core-8-4-16:1.9
	core-8-5-b1:1.13
	core-stablilizer-merge:1.13
	core-stabilizer-branch:1.13.0.2
	core-stabilizer-merge:1.15.2.1
	core-8-4-15:1.9
	core-8-5-a6:1.13
	core-8-5-a5:1.13
	core-8-4-14:1.9
	core-8-5-a4:1.12
	core-8-4-13:1.9
	core-8-4-12:1.9
	core-8-4-11:1.9
	core-8-5-a3:1.12
	core-8-4-10:1.9
	core-8-4-9-branch:1.9.0.4
	core-8-5-a2:1.11
	core-8-4-9:1.9
	core-8-4-8:1.9
	core-8-4-7:1.9
	core-8-5-a1:1.10
	core-8-4-6:1.9
	core-8-4-5:1.9
	mistachkin-dev-branch:1.10.0.2
	core-8-4-4:1.9
	core-8-4-3:1.9
	core-8-4-branch:1.9.0.2
	core-8-4-2:1.9
	core-8-4-1:1.9
	core-8-3-5:1.4.2.1
	core-8-4-0:1.9
	macosx-8-4-merge-2002-08-31-trunk:1.9
	macosx-8-4-premerge-2002-08-31-branch:1.7.2.3
	macosx-8-4-premerge-2002-08-31-trunk:1.9
	macosx-8-4-merge-2002-08-30-branch:1.7.2.3
	macosx-8-4-merge-2002-08-30-trunk:1.9
	macosx-8-4-merge-2002-08-20-branch:1.7.2.3
	macosx-8-4-merge-2002-08-20-trunk:1.9
	core-8-4-b2:1.9
	core-8-4-b1:1.7
	macosx-premerge-6-9-02:1.7.2.1
	core-8-4-a4:1.7
	core-8-3-4:1.4.2.1
	macosx-8-4-branch:1.7.0.2
	macosx-8-4-branchpoint:1.7
	core-8-4-a3:1.6
	core-8-3-3:1.4.2.1
	dgp-privates-into-namespace:1.5.0.4
	tclpro-1-5-0:1.4
	core-8-4-win-speedup:1.5.0.2
	core-8-4-a2:1.5
	tclpro-1-4-1:1.4
	tclpro-1-4-0:1.4
	core-8-3-2:1.4
	ajuba-ajuba2-2-1-base:1.4
	ajuba-ajuba2-2-0:1.4
	core-8-4-a1:1.4
	core-8-3-1-branch:1.4.0.2
	core-8-3-1:1.4
	scriptics-sc-2-0-b5:1.2
	scriptics-sc-2-0-fixed:1.2
	scriptics-sc-2-0-b2:1.2
	scriptics-sc-2-0-b1:1.2
	core-8-3-0:1.2
	core-8-3-b2:1.2
	core-8-3-b1:1.2
	scriptics-sc-1-1:1.2
	scriptics-sc-1-1-b1:1.2
	core-8-2-3:1.2
	scriptics-sc-1-1-branch:1.2.0.10
	scriptics-sc-1-1-base:1.2
	scriptics-sc-1-0:1.2
	scriptics-sc-1-0-branch:1.2.0.8
	scriptics-sc-1-0-base:1.2
	core-8-2-2:1.2
	core-8-2-1:1.2
	scriptics-bc-1-0-b1:1.2
	core-8-2-1-branch:1.2.0.6
	scriptics-tclpro-1-3-0:1.2
	core-8-2-0:1.2
	core-8-2-b3-branch:1.2.0.4
	core-8-2-b3-base:1.2
	scriptics-tclpro-1-3-b4:1.2
	core-8-2-b2:1.2
	scriptics-tclpro-1-3-b3:1.2
	core-8-2-b1:1.2
	scriptics-tclpro-1-3-b2:1.2
	merge-to-mainline-5/21/99:1.2
	scriptics-tclpro-1-3-b2-branch:1.2.0.2
	core-8-1-1:1.2
	scriptics-tclpro-1-3-b1:1.2
	core-8-1-1-base:1.2
	core-8-1-0:1.2
	merge-to-mainline-4-29-99:1.2
	merge-to-mainline-4-23-99:1.2
	core-8-1-branch-old:1.1.0.2
	core-8-1-b3:1.1.2.7
	core-8-1-b2:1.1.2.4
	dev-8-1-stubs-branch:1.1.2.2.0.2
	core-8-1-b1:1.1.2.2
	core-8-1-a2:1.1.2.1;
locks; strict;
comment	@# @;


1.26
date	2010.01.05.21.50.54;	author patthoyts;	state Exp;
branches;
next	1.25;

1.25
date	2008.12.10.13.41.19;	author patthoyts;	state Exp;
branches;
next	1.24;

1.24
date	2008.12.10.05.02.52;	author das;	state Exp;
branches;
next	1.23;

1.23
date	2008.11.22.12.22.12;	author patthoyts;	state Exp;
branches;
next	1.22;

1.22
date	2008.11.22.01.07.56;	author patthoyts;	state Exp;
branches;
next	1.21;

1.21
date	2008.10.07.18.33.47;	author dgp;	state Exp;
branches;
next	1.20;

1.20
date	2008.10.07.18.27.01;	author dgp;	state Exp;
branches;
next	1.19;

1.19
date	2008.10.06.22.09.16;	author patthoyts;	state Exp;
branches;
next	1.18;

1.18
date	2008.08.30.21.52.26;	author aniap;	state Exp;
branches;
next	1.17;

1.17
date	2008.05.13.12.39.28;	author patthoyts;	state Exp;
branches;
next	1.16;

1.16
date	2008.04.14.20.48.50;	author patthoyts;	state Exp;
branches;
next	1.15;

1.15
date	2007.12.13.15.27.55;	author dgp;	state Exp;
branches
	1.15.2.1;
next	1.14;

1.14
date	2007.10.25.21.44.23;	author hobbs;	state Exp;
branches;
next	1.13;

1.13
date	2006.10.17.10.21.50;	author patthoyts;	state Exp;
branches
	1.13.2.1;
next	1.12;

1.12
date	2004.12.20.10.34.20;	author vincentdarley;	state Exp;
branches;
next	1.11;

1.11
date	2004.06.17.22.38.57;	author dkf;	state Exp;
branches;
next	1.10;

1.10
date	2003.04.01.21.07.00;	author dgp;	state Exp;
branches;
next	1.9;

1.9
date	2002.07.13.20.28.36;	author dgp;	state Exp;
branches;
next	1.8;

1.8
date	2002.07.12.13.41.01;	author dgp;	state Exp;
branches;
next	1.7;

1.7
date	2001.09.21.20.38.18;	author hobbs;	state Exp;
branches
	1.7.2.1;
next	1.6;

1.6
date	2001.04.04.06.47.25;	author hobbs;	state Exp;
branches;
next	1.5;

1.5
date	2000.11.02.01.19.42;	author hobbs;	state Exp;
branches
	1.5.2.1
	1.5.4.1;
next	1.4;

1.4
date	2000.04.14.08.34.28;	author hobbs;	state Exp;
branches
	1.4.2.1;
next	1.3;

1.3
date	2000.04.08.06.59.37;	author hobbs;	state Exp;
branches;
next	1.2;

1.2
date	99.04.16.01.51.43;	author stanton;	state Exp;
branches;
next	1.1;

1.1
date	98.09.29.00.25.55;	author stanton;	state dead;
branches
	1.1.2.1;
next	;

1.1.2.1
date	98.09.29.00.25.56;	author stanton;	state Exp;
branches;
next	1.1.2.2;

1.1.2.2
date	98.09.30.02.19.06;	author stanton;	state Exp;
branches;
next	1.1.2.3;

1.1.2.3
date	99.03.11.18.51.21;	author hershey;	state Exp;
branches;
next	1.1.2.4;

1.1.2.4
date	99.03.14.01.22.53;	author hershey;	state Exp;
branches;
next	1.1.2.5;

1.1.2.5
date	99.03.24.01.17.18;	author hershey;	state Exp;
branches;
next	1.1.2.6;

1.1.2.6
date	99.03.24.02.55.12;	author hershey;	state Exp;
branches;
next	1.1.2.7;

1.1.2.7
date	99.03.26.00.08.11;	author hershey;	state Exp;
branches;
next	;

1.4.2.1
date	2001.04.04.07.57.17;	author hobbs;	state Exp;
branches;
next	;

1.5.2.1
date	2002.04.02.20.57.59;	author hobbs;	state Exp;
branches;
next	;

1.5.4.1
date	2001.07.03.20.01.09;	author dgp;	state Exp;
branches;
next	;

1.7.2.1
date	2001.10.15.09.22.00;	author wolfsuit;	state Exp;
branches;
next	1.7.2.2;

1.7.2.2
date	2002.06.10.05.38.26;	author wolfsuit;	state Exp;
branches;
next	1.7.2.3;

1.7.2.3
date	2002.08.20.20.27.16;	author das;	state Exp;
branches;
next	;

1.13.2.1
date	2007.10.27.04.23.17;	author dgp;	state Exp;
branches;
next	1.13.2.2;

1.13.2.2
date	2008.06.25.16.46.13;	author dgp;	state Exp;
branches;
next	;

1.15.2.1
date	2008.04.14.20.59.51;	author patthoyts;	state Exp;
branches;
next	1.15.2.2;

1.15.2.2
date	2008.11.12.22.35.14;	author patthoyts;	state Exp;
branches;
next	1.15.2.3;

1.15.2.3
date	2009.11.13.23.32.05;	author patthoyts;	state Exp;
branches;
next	;


desc
@@


1.26
log
@Patch 289825: Enable unlimited multiple	file selection from the open files dialog
@
text
@# -*- tcl -*-
# This file is a Tcl script to test the Windows specific behavior of
# the common dialog boxes.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 ActiveState Corporation.
#
# RCS: @@(#) $Id: winDialog.test,v 1.25 2008/12/10 13:41:19 patthoyts Exp $

package require tcltest 2.2
namespace import ::tcltest::*
tcltest::configure {*}$argv
tcltest::loadTestedCommands

if {[testConstraint testwinevent]} {
    catch {testwinevent debug 1}
}

# Locale identifier LANG_ENGLISH is 0x09
testConstraint english [expr {
    [llength [info commands testwinlocale]]
    && (([testwinlocale] & 0xff) == 9)
}]

proc start {arg} {
    set ::tk_dialog 0
    set ::iter_after 0

    after 1 $arg
}

proc then {cmd} {
    set ::command $cmd
    set ::dialogresult {}
    set ::testfont {}

    afterbody
    vwait ::dialogresult
    return $::dialogresult
}

proc afterbody {} {
    if {$::tk_dialog == 0} {
        if {[incr ::iter_after] > 30} {
            set ::dialogresult ">30 iterations waiting on tk_dialog"
            return
        }
        after 150 {afterbody}
        return
    }
    uplevel #0 {set dialogresult [eval $command]}
}

proc Click {button} {
    switch -exact -- $button {
        ok     { set button 1 }
        cancel { set button 2 }
    }
    testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
    testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
}

proc GetText {id} {
    switch -exact -- $id {
        ok     { set id 1 }
        cancel { set id 2 }
    }
    return [testwinevent $::tk_dialog $id WM_GETTEXT]
}

proc SetText {id text} {
    return [testwinevent $::tk_dialog $id WM_SETTEXT $text]
}

proc ApplyFont {font} {
     set ::testfont $font
}

# ----------------------------------------------------------------------

test winDialog-1.1 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {tk_chooseColor}
    then {
        Click cancel
    }
} -result {0}
test winDialog-1.2 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click cancel]
    }
    list $x $clr
} -result {0 {}}
test winDialog-1.3 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click ok]
    }
    list $x $clr
} -result [list 0 "#ff9933"]
test winDialog-1.4 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    set x {}
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]}
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
        lappend x [Click ok]
    }
    lappend x $clr
} -result [list Hello 0 "#ff9933"]
test winDialog-1.5 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    set x {}
    start {
        set clr [tk_chooseColor -initialcolor "#ff9933" \
                     -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
    }
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
        lappend x [Click ok]
    }
    lappend x $clr
} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
test winDialog-1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -setup {
    catch {unset a x}
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]}
    set x {}
    then {
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(parent)]} {
                append x [expr {$a(parent) == [wm frame .]}]
            }
        } err]} {lappend x $err}
        Click ok
    }
    list $x $clr
} -result [list 1 "#ff9933"]
test winDialog-1.7 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12
} -returnCodes error -match glob -result {bad window path name*}


test winDialog-2.1 {ColorDlgHookProc} -constraints {emptyTest nt} -body {}

test winDialog-3.1 {Tk_GetOpenFileObjCmd} -constraints {
    nt testwinevent english
} -body {
    start {tk_getOpenFile}
    then {
        set x [GetText cancel]
        Click cancel
    }
    return $x
} -result {Cancel}


test winDialog-4.1 {Tk_GetSaveFileObjCmd} -constraints {
    nt testwinevent english
} -body {
    start {tk_getSaveFile}
    then {
        set x [GetText cancel]
        Click cancel
    }
    return $x
} -result {Cancel}

test winDialog-5.1 {GetFileName: no arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -title Open}
    then {
        Click cancel
    }
} -result {0}
test winDialog-5.2 {GetFileName: one argument} -constraints {
    nt
} -body {
    tk_getOpenFile -foo
} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
test winDialog-5.3 {GetFileName: many arguments} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    then {
        Click cancel
    }
} -result {0}
test winDialog-5.4 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt
} -body {
    tk_getOpenFile -foo bar -abc
} -returnCodes error -result {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
    nt testwinevent
} -body {
    start {tk_getOpenFile -title bar}
    then {
        Click cancel
    }
} -result {0}
test winDialog-5.6 {GetFileName: valid option, but missing value} -constraints {
    nt
} -body {
    tk_getOpenFile -initialdir bar -title
} -returnCodes error -result {value for "-title" missing}
test winDialog-5.7 {GetFileName: extension begins with .} -constraints {
    nt testwinevent
} -body {
#    if (string[0] == '.') {
#    string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    then {
        SetText 0x480 bar
        Click ok
    }
    string totitle $x
} -result [string totitle [file join [pwd] bar.foo]]
test winDialog-5.8 {GetFileName: extension doesn't begin with .} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    then {
        SetText 0x480 bar
        Click ok
    }
    string totitle $x
} -result [string totitle [file join [pwd] bar.foo]]
test winDialog-5.9 {GetFileName: file types} -constraints {
    nt testwinevent
} -body {
#        case FILE_TYPES:

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
        set x [GetText 0x470]
        Click cancel
    }
    return $x
} -result {foo files (*.foo)}
test winDialog-5.10 {GetFileName: file types: MakeFilter() fails} -constraints {
    nt
} -body {
#        if (MakeFilter(interp, string, &utfFilterString) != TCL_OK)

    tk_getSaveFile -filetypes {{"foo" .foo FOO}}
} -returnCodes error -result {bad Macintosh file type "FOO"}
if {[info exists ::env(TEMP)]} {
test winDialog-5.11 {GetFileName: initial directory} -constraints {
    nt testwinevent
} -body {
#        case FILE_INITDIR:

    start {set x [tk_getSaveFile \
                      -initialdir [file normalize $::env(TEMP)] \
                      -initialfile "12x 455" -title Foo]}
    then {
        Click ok
    }
    return $x
} -result [file join [file normalize $::env(TEMP)] "12x 455"]
}
test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints {
    nt
} -body {
#        if (Tcl_TranslateFileName(interp, string, &ds) == NULL)

    tk_getOpenFile -initialdir ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}
test winDialog-5.13 {GetFileName: initial file} -constraints {
    nt testwinevent
} -body {
#        case FILE_INITFILE:

    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
    then {
        Click ok
    }
    string totitle $x
} -result [string totitle [file join [pwd] "12x 456"]]
test winDialog-5.14 {GetFileName: initial file: Tcl_TranslateFileName()} -constraints {
    nt
} -body {
#        if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
    tk_getOpenFile -initialfile ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}
test winDialog-5.15 {GetFileName: initial file: long name} -constraints {
    nt testwinevent
} -body {
    start {
        set dialogresult [catch {
            tk_getSaveFile -initialfile [string repeat a 1024] -title Long
        } x]
    }
    then {
        Click ok
    }
    list $dialogresult [string match "invalid filename *" $x]
} -result {1 1}
test winDialog-5.16 {GetFileName: parent} -constraints {
    nt
} -body {
#        case FILE_PARENT:

    toplevel .t
    set x 0
    start {tk_getOpenFile -parent .t -title Parent; set x 1}
    then {
        destroy .t
    }
    return $x
} -result {1}
test winDialog-5.17 {GetFileName: title} -constraints {
    nt testwinevent
} -body {
#        case FILE_TITLE:
   
    start {tk_getOpenFile -title Narf}
    then {
        Click cancel
    }
} -result {0}
test winDialog-5.18 {GetFileName: no filter specified} -constraints {
    nt testwinevent
} -body {
#    if (ofn.lpstrFilter == NULL)

    start {tk_getOpenFile -title Filter}
    then {
    set x [GetText 0x470]
        Click cancel
    }
    return $x
} -result {All Files (*.*)}
test winDialog-5.19 {GetFileName: parent HWND doesn't yet exist} -constraints {
    nt
} -setup {
    destroy .t
} -body {
#    if (Tk_WindowId(parent) == None)

    toplevel .t
    start {tk_getOpenFile -parent .t -title Open}
    then {
        destroy .t
    }
} -result {}
test winDialog-5.20 {GetFileName: parent HWND already exists} -constraints {
    nt
} -setup {
    destroy .t
} -body {
    toplevel .t
    update
    start {tk_getOpenFile -parent .t -title Open}
    then {
        destroy .t
    }
} -result {}
test winDialog-5.21 {GetFileName: call GetOpenFileName} -constraints {
    nt testwinevent english
} -body {
#        winCode = GetOpenFileName(&ofn);
   
    start {tk_getOpenFile -title Open}
    then {
        set x [GetText ok]
        Click cancel
    }
    return $x
} -result {&Open}
test winDialog-5.22 {GetFileName: call GetSaveFileName} -constraints {
    nt testwinevent english
} -body {
#        winCode = GetSaveFileName(&ofn);

    start {tk_getSaveFile -title Save}
    then {
        set x [GetText ok]
        Click cancel
    }
    return $x
} -result {&Save}
if {[info exists ::env(TEMP)]} {
test winDialog-5.23 {GetFileName: convert \ to /} -constraints {
    nt testwinevent
} -body {
    start {set x [tk_getSaveFile -title Back]}
    then {
        SetText 0x480 [file nativename \
                           [file join [file normalize $::env(TEMP)] "12x 457"]]
        Click ok
    }
    return $x
} -result [file join [file normalize $::env(TEMP)] "12x 457"]
}
test winDialog-5.24 {GetFileName: file types: MakeFilter() succeeds} -constraints {
    nt
} -body {
    # MacOS type that is correct, but has embedded nulls.

    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\0\0\0\0}}}}]}
    then {
        Click cancel
    }
    return $x
} -result {0}
test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} -constraints {
    nt
} -body {
    # MacOS type that is correct, but has embedded high-bit chars.

    start {set x [catch {tk_getSaveFile -filetypes {{"foo" .foo {\u2022\u2022\u2022\u2022}}}}]}
    then {
        Click cancel
    }
    return $x
} -result {0}


test winDialog-6.1 {MakeFilter} -constraints {emptyTest nt} -body {}


test winDialog-7.1 {Tk_MessageBoxObjCmd} -constraints {emptyTest nt} -body {}


test winDialog-8.1 {OFNHookProc} -constraints {emptyTest nt} -body {}


## 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} -constraints {
    nt testwinevent
} -body {
    start {tk_chooseDirectory}
    then {
        Click cancel
    }
} -result {0}
test winDialog-9.2 {Tk_ChooseDirectoryObjCmd: one argument} -constraints {
    nt
} -body {
    tk_chooseDirectory -foo
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} -constraints {
    nt testwinevent
} -body {
    start {
    tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
    }
    then {
        Click cancel
    }
} -result {0}
test winDialog-9.4 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} -constraints {
    nt
} -body {
    tk_chooseDirectory -foo bar -abc
} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title}
test winDialog-9.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} -constraints {
    nt testwinevent
} -body {
    start {tk_chooseDirectory -title bar}
    then {
        Click cancel
    }
} -result {0}
test winDialog-9.6 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} -constraints {
    nt
} -body {
    tk_chooseDirectory -initialdir bar -title
} -returnCodes error -result {value for "-title" missing}
test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} -constraints {
    nt testwinevent
} -body {
#        case DIR_INITIAL:

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    then {
        Click ok
    }
    string tolower [set x]
} -result {c:/}
test winDialog-9.8 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} -constraints {
    nt
} -body {
#        if (Tcl_TranslateFileName(interp, string,
#            &utfDirString) == NULL)
   
    tk_chooseDirectory -initialdir ~12x/455
} -returnCodes error -result {user "12x" doesn't exist}


test winDialog-10.1 {Tk_FontchooserObjCmd: no arguments} -constraints {
    nt testwinevent
} -body {
    start {tk fontchooser show}
    list [then {
	Click cancel
    }] $::testfont
} -result {0 {}}
test winDialog-10.2 {Tk_FontchooserObjCmd: -initialfont} -constraints {
    nt testwinevent
} -body {
    start {
        tk fontchooser configure -command ApplyFont -font system
        tk fontchooser show
    }
    list [then {
	Click cancel
    }] $::testfont
} -result {0 {}}
test winDialog-10.3 {Tk_FontchooserObjCmd: -initialfont} -constraints {
    nt testwinevent
} -body {
    start {
        tk fontchooser configure -command ApplyFont -font system
        tk fontchooser show
    }
    list [then {
	Click 1
    }] [expr {[llength $::testfont] ne {}}]
} -result {0 1}
test winDialog-10.4 {Tk_FontchooserObjCmd: -title} -constraints {
    nt testwinevent
} -body {
    start {
        tk fontchooser configure -command ApplyFont -title "tk test"
        tk fontchooser show
    }
    list [then {
	Click cancel
    }] $::testfont
} -result {0 {}}
test winDialog-10.5 {Tk_FontchooserObjCmd: -parent} -constraints {
    nt testwinevent
} -setup {
    array set a {parent {}}
} -body {
    start {
        tk fontchooser configure -command ApplyFont -parent .
        tk fontchooser show
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
	Click cancel
    }
    list [expr {$a(parent) == [wm frame .]}] $::testfont
} -result {1 {}}
test winDialog-10.6 {Tk_FontchooserObjCmd: -apply} -constraints {
    nt testwinevent
} -body {
    start {
        tk fontchooser configure -command FooBarBaz
        tk fontchooser show
    }
    then {
	Click cancel
    }
} -result 0
test winDialog-10.7 {Tk_FontchooserObjCmd: -apply} -constraints {
    nt testwinevent
} -body {
    start {
        tk fontchooser configure -command ApplyFont -parent .
        tk fontchooser show
    }
    list [then {
	Click [expr {0x0402}] ;# value from XP
        Click cancel
    }] [expr {[llength $::testfont] > 0}]
} -result {0 1}
test winDialog-10.8 {Tk_FontchooserObjCmd: -title} -constraints {
    nt testwinevent
} -setup {
    array set a {text failed}
} -body {
    start {
        tk fontchooser configure -command ApplyFont -title "Hello"
        tk fontchooser show
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        Click cancel
    }
    set a(text)
} -result "Hello"
test winDialog-10.9 {Tk_FontchooserObjCmd: -title} -constraints {
    nt testwinevent
} -setup {
    array set a {text failed}
} -body {
    start {
        tk fontchooser configure -command ApplyFont \
            -title  "\u041f\u0440\u0438\u0432\u0435\u0442"
        tk fontchooser show
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        Click cancel
    }
    set a(text)
} -result "\u041f\u0440\u0438\u0432\u0435\u0442"

if {[testConstraint testwinevent]} {
    catch {testwinevent debug 0}
}

# cleanup
cleanupTests
return

# Local variables:
# mode: tcl
# End:

@


1.25
log
@Fix some problems running the tests on windows. As Tk tests run in -singleproc 1 we cannot do the script testing without damaging the later native tests.
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.24 2008/12/10 05:02:52 das Exp $
a170 1

@


1.24
log
@TIP #324 IMPLEMENTATION
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.23 2008/11/22 12:22:12 patthoyts Exp $
d46 5
a50 2
    if {[incr ::iter_after] > 30} {
        set ::dialogresult ">30 iterations waiting on tk_dialog"
a52 3
    after 150 {afterbody}
    return
    }
@


1.23
log
@Fixed internationalization issues with the winDialog tests
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.22 2008/11/22 01:07:56 patthoyts Exp $
d37 1
d77 4
d524 112
@


1.22
log
@[Bug 2307837] avoid some locale-dependent failures by using id's or an english constraint
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.21 2008/10/07 18:33:47 dgp Exp $
d24 1
a24 1
    && (([testwinlocale] & 0x09) == 9)
d414 2
a415 1
        SetText 0x480 "$::env(TEMP)\\12x 457"
@


1.21
log
@and another one
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.20 2008/10/07 18:27:01 dgp Exp $
d21 6
d56 4
d64 6
a69 2
proc GetText {button} {
    return [testwinevent $::tk_dialog $button WM_GETTEXT]
d72 2
a73 2
proc SetText {button text} {
    return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
d100 1
a100 1
        set x [Click 1]
d116 1
a116 1
        lappend x [Click 1]
d135 1
a135 1
        lappend x [Click 1]
d153 1
a153 1
        Click 1
d168 1
a168 1
    nt testwinevent
d172 2
a173 2
        set x [GetText 2]
        Click 2
d180 1
a180 1
    nt testwinevent
d184 2
a185 2
        set x [GetText 2]
        Click 2
d239 1
a239 1
        Click 1
d249 1
a249 1
        Click 1
d282 1
a282 1
        Click 1
d301 1
a301 1
        Click 1
d320 1
a320 1
        Click 1
d344 1
a344 1
        Click 2
d355 1
a355 1
        Click 2
d385 1
a385 1
    nt testwinevent
d391 2
a392 2
        set x [GetText 1]
        Click 2
d397 1
a397 1
    nt testwinevent
d403 2
a404 2
        set x [GetText 1]
        Click 2
d415 1
a415 1
        Click 1
d427 1
a427 1
        Click 2
d438 1
a438 1
        Click 2
d505 1
a505 1
        Click 1
@


1.20
log
@Simpleminded protection against fatal error when env(TEMP) is not defined.
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.19 2008/10/06 22:09:16 patthoyts Exp $
d394 1
d405 1
@


1.19
log
@Fixed tests for Vista (cannot write to C:\)
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.18 2008/08/30 21:52:26 aniap Exp $
d258 1
d272 1
@


1.18
log
@Update to tcltest2
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.17 2008/05/13 12:39:28 patthoyts Exp $
d263 3
a265 1
    start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
d270 1
a270 1
} -result {C:/12x 455}
d397 1
a397 1
        SetText 0x480 "c:\\12x 457"
d401 1
a401 1
} -result {c:/12x 457}
@


1.17
log
@Fixed a hangup in the tk_chooseColor tests by ensuring the temporary array is unset
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.16 2008/04/14 20:48:50 patthoyts Exp $
d12 3
a14 2
package require tcltest 2.1
eval tcltest::configure $argv
d39 6
a44 6
	if {[incr ::iter_after] > 30} {
	    set ::dialogresult ">30 iterations waiting on tk_dialog"
	    return
	}
	after 150 {afterbody}
	return
d62 3
a64 1
test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints {
d72 1
a72 1
test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints {
d81 1
a81 1
test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints {
d90 1
a90 1
test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints {
d92 3
a94 1
} -setup {unset a x} -body {
d106 1
a106 1
test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints {
d108 3
a110 1
} -setup {unset a x} -body {
d125 1
a125 1
test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints {
d127 3
a129 1
} -setup {unset a x} -body {
d143 1
a143 1
test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
a148 2
test winDialog-2.1 {ColorDlgHookProc} {emptyTest nt} {
} {}
d150 6
a155 1
test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} {
d158 2
a159 2
	set x [GetText 2]
	Click 2
d161 2
a162 2
    set x
} {Cancel}
d164 4
a167 1
test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} {
d170 2
a171 2
	set x [GetText 2]
	Click 2
d173 2
a174 2
    set x
} {Cancel}
d176 3
a178 1
test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} {
d181 1
a181 1
	Click cancel
d183 9
a191 5
} {0}
test winDialog-5.2 {GetFileName: one argument} {nt} {
    list [catch {tk_getOpenFile -foo} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
d194 1
a194 1
	Click cancel
d196 9
a204 5
} {0}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
    list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
d207 1
a207 1
	Click cancel
d209 9
a217 5
} {0}
test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
    list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} {
d219 1
a219 1
#	string++;
d224 2
a225 2
	SetText 0x480 bar
	Click 1
d228 4
a231 2
} [string totitle [file join [pwd] bar.foo]]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} {
d234 2
a235 2
	SetText 0x480 bar
	Click 1
d238 5
a242 3
} [string totitle [file join [pwd] bar.foo]]
test winDialog-5.10 {GetFileName: file types} {nt testwinevent} {
#	    case FILE_TYPES: 
d246 2
a247 2
	set x [GetText 0x470]
	Click cancel
d249 13
a261 9
    set x
} {foo files (*.foo)}
test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
#		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 

    list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
} {1 {bad Macintosh file type "FOO"}}
test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} {
#	    case FILE_INITDIR: 
d265 1
a265 1
	Click 1
d267 13
a279 10
    set x
} {C:/12x 455}
test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
	{nt} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    
    list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} {
#	    case FILE_INITFILE: 
d283 1
a283 1
	Click 1
d286 10
a295 6
} [string totitle [file join [pwd] "12x 456"]]
test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} {
d302 1
a302 1
	Click 1
d305 5
a309 3
} {1 1}
test winDialog-5.17 {GetFileName: parent} {nt} {
#	    case FILE_PARENT: 
d315 1
a315 1
	destroy .t
d317 7
a323 5
    set x
} {1}
test winDialog-5.18 {GetFileName: title} {nt testwinevent} {
#	    case FILE_TITLE: 
    
d326 1
a326 1
	Click 2
d328 5
a332 3
} {0}
test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} {
#    if (ofn.lpstrFilter == NULL) 
d334 1
a334 1
    start {tk_getOpenFile -title Filter} 
d336 2
a337 2
	set x [GetText 0x470]
	Click 2
d339 8
a346 4
    set x
} {All Files (*.*)}
test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
#    if (Tk_WindowId(parent) == None) 
d351 1
a351 1
	destroy .t
d353 6
a358 2
} {}
test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
d363 1
a363 1
	destroy .t
d365 6
a370 4
} {}
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} {
#	    winCode = GetOpenFileName(&ofn);
    
d373 2
a374 2
	set x [GetText 1]
	Click 2
d376 6
a381 4
    set x
} {&Open}
test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} {
#	    winCode = GetSaveFileName(&ofn);
d385 2
a386 2
	set x [GetText 1]
	Click 2
d388 5
a392 3
    set x
} {&Save}
test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} {
d395 2
a396 2
	SetText 0x480 "c:\\12x 457"
	Click 1
d398 5
a402 3
    set x
} {c:/12x 457}
test winDialog-5.25 {GetFileName: file types: MakeFilter() succeeds} {nt} {
d407 1
a407 1
	Click 2
d409 5
a413 3
    set x
} {0}
test winDialog-5.26 {GetFileName: file types: MakeFilter() succeeds} {nt} {
d418 1
a418 1
	Click 2
d420 6
a425 2
    set x
} {0}
d427 1
a427 1
test winDialog-6.1 {MakeFilter} {emptyTest nt} {} {}
a428 1
test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
d430 2
a431 1
test winDialog-8.1 {OFNHookProc} {emptyTest nt} {} {}
d437 3
a439 1
test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} {
d442 1
a442 1
	Click cancel
d444 9
a452 5
} {0}
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-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} {
d454 1
a454 1
	tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test
d457 1
a457 1
	Click cancel
d459 9
a467 7
} {0}
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-9.5 {Tk_ChooseDirectoryObjCmd:\
	Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
d470 1
a470 1
	Click cancel
d472 10
a481 7
} {0}
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-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} {
#	    case DIR_INITIAL: 
d485 1
a485 1
	Click 1
d488 9
a496 8
} {c:/}
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}}
d505 5
@


1.16
log
@Fixed bug #1941740: tk_chooseColor -title was broken in revision 1.40 after some code cleanup. Added tests for this windows dialog to avoid regression.
@
text
@d1 1
d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.15 2007/12/13 15:27:55 dgp Exp $
d89 1
a89 1
} -body {
d93 4
a96 2
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
d103 1
a103 1
} -body {
d110 4
a113 2
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
d120 1
a120 1
} -body {
d124 6
a129 4
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(parent)]} {
            append x [expr {$a(parent) == [wm frame .]}]
        }
@


1.15
log
@merge stable branch onto HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.13.2.1 2007/10/27 04:23:17 dgp Exp $
d60 72
a131 2
test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
} {}
d133 1
a133 1
test winDialog-2.1 {ColorDlgHookProc} {nt} {
@


1.15.2.1
log
@backported tk_chooseColor -title fix from HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.15 2007/12/13 15:27:55 dgp Exp $
d60 2
a61 72
test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {tk_chooseColor}
    then {
        Click cancel
    }
} -result {0}
test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click cancel]
    }
    list $x $clr
} -result {0 {}}
test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click 1]
    }
    list $x $clr
} -result [list 0 "#ff9933"]
test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -body {
    set x {}
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]}
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
        lappend x [Click 1]
    }
    lappend x $clr
} -result [list Hello 0 "#ff9933"]
test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -body {
    set x {}
    start {
        set clr [tk_chooseColor -initialcolor "#ff9933" \
                     -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
        lappend x [Click 1]
    }
    lappend x $clr
} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]}
    set x {}
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(parent)]} {
            append x [expr {$a(parent) == [wm frame .]}]
        }
        Click 1
    }
    list $x $clr
} -result [list 1 "#ff9933"]
test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12
} -returnCodes error -match glob -result {bad window path name*}
d63 1
a63 1
test winDialog-2.1 {ColorDlgHookProc} {emptyTest nt} {
@


1.15.2.2
log
@backported fixes for running on vista and to avoid a hangup in the color dialog test sometimes.
@
text
@a0 1
# -*- tcl -*-
d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.15.2.1 2008/04/14 20:59:51 patthoyts Exp $
d88 1
a88 1
} -setup {unset -nocomplain a x} -body {
d92 2
a93 4
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
d100 1
a100 1
} -setup {unset -nocomplain a x} -body {
d107 2
a108 4
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(text)]} {lappend x $a(text)}
        } err]} { lappend x $err }
d115 1
a115 1
} -setup {unset -nocomplain a x} -body {
d119 4
a122 6
        if {[catch {
            array set a [testgetwindowinfo $::tk_dialog]
            if {[info exists a(parent)]} {
                append x [expr {$a(parent) == [wm frame .]}]
            }
        } err]} {lappend x $err}
a215 1
if {[info exists ::env(TEMP)]} {
d219 1
a219 3
    start {set x [tk_getSaveFile \
                      -initialdir [file normalize $::env(TEMP)] \
                      -initialfile "12x 455" -title Foo]}
d224 1
a224 2
} [file join [file normalize $::env(TEMP)] "12x 455"]
}
a320 1
if {[info exists ::env(TEMP)]} {
d324 1
a324 1
	SetText 0x480 "$::env(TEMP)\\12x 457"
d328 1
a328 2
} [file join [file normalize $::env(TEMP)] "12x 457"]
}
@


1.15.2.3
log
@[Bug 2307837] Backported fix for running dialog tests on non-English locales
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.15.2.2 2008/11/12 22:35:14 patthoyts Exp $
a19 6
# Locale identifier LANG_ENGLISH is 0x09
testConstraint english [expr {
    [llength [info commands testwinlocale]]
    && (([testwinlocale] & 0xff) == 9)
}]

a48 4
    switch -exact -- $button {
        ok     { set button 1 }
        cancel { set button 2 }
    }
d53 2
a54 6
proc GetText {id} {
    switch -exact -- $id {
        ok     { set id 1 }
        cancel { set id 2 }
    }
    return [testwinevent $::tk_dialog $id WM_GETTEXT]
d57 2
a58 2
proc SetText {id text} {
    return [testwinevent $::tk_dialog $id WM_SETTEXT $text]
d83 1
a83 1
        set x [Click ok]
d97 1
a97 1
        lappend x [Click ok]
d114 1
a114 1
        lappend x [Click ok]
d130 1
a130 1
        Click ok
d143 1
a143 1
test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent english} {
d146 2
a147 2
	set x [GetText cancel]
	Click cancel
d152 1
a152 1
test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent english} {
d155 2
a156 2
	set x [GetText cancel]
	Click cancel
d196 1
a196 1
	Click ok
d204 1
a204 1
	Click ok
d231 1
a231 1
	Click ok
d247 1
a247 1
	Click ok
d262 1
a262 1
	Click ok
d282 1
a282 1
	Click cancel
d291 1
a291 1
	Click cancel
d312 1
a312 1
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent english} {
d317 2
a318 2
	set x [GetText ok]
	Click cancel
d322 1
a322 1
test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent english} {
d327 2
a328 2
	set x [GetText ok]
	Click cancel
d336 2
a337 3
	SetText 0x480 [file nativename \
                           [file join [file normalize $::env(TEMP)] "12x 457"]]
	Click ok
d347 1
a347 1
	Click cancel
d356 1
a356 1
	Click cancel
d408 1
a408 1
	Click ok
@


1.14
log
@	* doc/getOpenFile.n:  TIP#242 implementation of -typevariable to
	* library/tkfbox.tcl: return type of selected file in file dialogs.
	* library/xmfbox.tcl: [Bug #1156388]
	* macosx/tkMacOSXDialog.c:
	* tests/filebox.test:
	* tests/winDialog.test:
	* win/tkWinDialog.c:
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
@


1.13
log
@generic/tkText.c: Applied suggested patch from #1536735
tests/text.test:  Update test for above patch.
tests/textWind.test:  Corrected test to catch all messages
tests/safe.test: Silence spurious win32 failure awaiting TIP150
tests/winDialog.test: Updated test for file name length check.
test/winWm.test: Corrected test expectation for menu wrapping.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.12 2004/12/20 10:34:20 vincentdarley Exp $
d92 1
a92 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
d101 1
a101 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, or -title}}
@


1.13.2.1
log
@merge updates from HEAD
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
d92 1
a92 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
d101 1
a101 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent, -title, or -typevariable}}
@


1.13.2.2
log
@merge updates from 8.5 branch
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.13.2.1 2007/10/27 04:23:17 dgp Exp $
d60 2
a61 72
test winDialog-1.1.0 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {tk_chooseColor}
    then {
        Click cancel
    }
} -result {0}
test winDialog-1.1.1 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click cancel]
    }
    list $x $clr
} -result {0 {}}
test winDialog-1.1.2 {Tk_ChooseColorObjCmd} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933"]}
    then {
        set x [Click 1]
    }
    list $x $clr
} -result [list 0 "#ff9933"]
test winDialog-1.1.3 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -body {
    set x {}
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -title "Hello"]}
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
        lappend x [Click 1]
    }
    lappend x $clr
} -result [list Hello 0 "#ff9933"]
test winDialog-1.1.4 {Tk_ChooseColorObjCmd: -title} -constraints {
    testwinevent
} -body {
    set x {}
    start {
        set clr [tk_chooseColor -initialcolor "#ff9933" \
                     -title "\u041f\u0440\u0438\u0432\u0435\u0442"]
    }
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(text)]} {lappend x $a(text)}
        lappend x [Click 1]
    }
    lappend x $clr
} -result [list "\u041f\u0440\u0438\u0432\u0435\u0442" 0 "#ff9933"]
test winDialog-1.1.5 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    start {set clr [tk_chooseColor -initialcolor "#ff9933" -parent .]}
    set x {}
    then {
        array set a [testgetwindowinfo $::tk_dialog]
        if {[info exists a(parent)]} {
            append x [expr {$a(parent) == [wm frame .]}]
        }
        Click 1
    }
    list $x $clr
} -result [list 1 "#ff9933"]
test winDialog-1.1.6 {Tk_ChooseColorObjCmd: -parent} -constraints {
    testwinevent
} -body {
    tk_chooseColor -initialcolor "#ff9933" -parent .xyzzy12
} -returnCodes error -match glob -result {bad window path name*}
d63 1
a63 1
test winDialog-2.1 {ColorDlgHookProc} {emptyTest nt} {
@


1.12
log
@Corrected handling of MacOS filetypes in tk_*file dialogs
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.11 2004/06/17 22:38:57 dkf Exp $
a173 5
set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
append a $a
append a $a
append a $a
append a $a
d175 5
a179 1
    start {set x [tk_getSaveFile -initialfile $a -title Long]}
d183 2
a184 2
    string totitle $x
} [string totitle [string range [file join [pwd] $a] 0 257]]
@


1.11
log
@Steps towards systematization of test constraints in Tk test suite
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.10 2003/04/01 21:07:00 dgp Exp $
d260 18
@


1.10
log
@        * tests/all.tcl:                Made better use of a common
        * tests/constraints.tcl:        -loadfile to hold definitions
        * tests/*.test:                 common to all test files.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.9 2002/07/13 20:28:36 dgp Exp $
d15 3
a17 3
testConstraint testwinevent [llength [info commands testwinevent]]

catch {testwinevent debug 1}
d320 3
a322 1
catch {testwinevent debug 0}
@


1.9
log
@	* Converted more files to tcltest and factored out common code.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.8 2002/07/12 13:41:01 dgp Exp $
d12 1
a12 4
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
d323 1
a323 1
::tcltest::cleanupTests
@


1.8
log
@	* Converted several files in the Tk test suite for testing by
	tcltest 2.1.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.7 2001/09/21 20:38:18 hobbs Exp $
d12 6
a17 3
namespace import -force tcltest::test
namespace import -force tcltest::testConstraint
eval tcltest::configure $argv
a20 4

eval destroy [winfo children .] 
wm geometry . {}
raise .
@


1.7
log
@	improved use of test constraints
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.6 2001/04/04 06:47:25 hobbs Exp $
d11 5
a15 6
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

set ::tcltest::testConfig(testwinevent) \
	[llength [info commands testwinevent]]
@


1.7.2.1
log
@First checkin of support for Tk on Mac OS X.
@
text
@d9 1
a9 5
<<<<<<< winDialog.test
# RCS: @@(#) $Id$
=======
# RCS: @@(#) $Id$
>>>>>>> 1.7
a125 5
<<<<<<< winDialog.test
    set x
} [file join [pwd] bar.foo]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
=======
a128 1
>>>>>>> 1.7
a133 5
<<<<<<< winDialog.test
    set x
} [file join [pwd] bar.foo]
test winDialog-5.10 {GetFileName: file types} {nt} {
=======
a136 1
>>>>>>> 1.7
d173 2
a174 2
    set x
} [file join [pwd] "12x 456"]
d189 2
a190 2
    set x
} [string range [file join [pwd] $a] 0 257]
@


1.7.2.2
log
@Merging with TOT as of 06/09/2002.
@
text
@d9 1
d11 3
d130 5
d138 1
d144 5
d152 1
d189 2
a190 2
    string totitle $x
} [string totitle [file join [pwd] "12x 456"]]
d205 2
a206 2
    string totitle $x
} [string totitle [string range [file join [pwd] $a] 0 257]]
@


1.7.2.3
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d11 3
a13 6
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
d15 2
a16 1
testConstraint testwinevent [llength [info commands testwinevent]]
d19 4
@


1.6
log
@	* tests/winDialog.test: string totitle'd some results that
	expected [pwd] to return a capital drive letter.
@
text
@d7 1
a7 1
# All rights reserved.
d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.5 2000/11/02 01:19:42 hobbs Exp $
d15 2
a16 5
if {[info command testwinevent] == ""} {
    puts "skipping: tests require the testwinevent command"
    ::tcltest::cleanupTests
    return
}
d18 1
a18 1
testwinevent debug 1
d46 1
a46 1
	after 100 {afterbody}
d50 1
a50 1
}    
d55 1
a55 1
}	    
d71 1
a71 1
test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
d80 1
a80 1
test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
d89 1
a89 1
test winDialog-5.1 {GetFileName: no arguments} {nt} {
d98 1
a98 1
test winDialog-5.4 {GetFileName: many arguments} {nt} {
d107 1
a107 1
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
d116 1
a116 1
test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
d128 1
a128 1
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
d136 1
a136 1
test winDialog-5.10 {GetFileName: file types} {nt} {
d151 1
a151 1
test winDialog-5.12 {GetFileName: initial directory} {nt} {
d166 1
a166 1
test winDialog-5.14 {GetFileName: initial file} {nt} {
d184 1
a184 1
test winDialog-5.16 {GetFileName: initial file: long name} {nt} {
d202 1
a202 1
test winDialog-5.18 {GetFileName: title} {nt} {
d210 1
a210 1
test winDialog-5.19 {GetFileName: no filter specified} {nt} {
d237 1
a237 1
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
d247 1
a247 1
test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt} {
d257 1
a257 1
test winDialog-5.24 {GetFileName: convert \ to /} {nt} {
d276 1
a276 1
test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
d285 1
a285 1
test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
d298 1
a298 1
	Tcl_GetIndexFromObj() == TCL_OK} {nt} {
d308 1
a308 1
test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt} {
d325 1
a325 1
testwinevent debug 0
@


1.5
log
@corrected tests to recognize new -multiple openfile dialog switch
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.4 2000/04/14 08:34:28 hobbs Exp $
d129 2
a130 2
    set x
} [file join [pwd] bar.foo]
d137 2
a138 2
    set x
} [file join [pwd] bar.foo]
d176 2
a177 2
    set x
} [file join [pwd] "12x 456"]
d192 2
a193 2
    set x
} [string range [file join [pwd] $a] 0 257]
@


1.5.2.1
log
@sync with head
@
text
@d7 1
a7 1
# Copyright (c) 1998-1999 ActiveState Corporation.
d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.7 2001/09/21 20:38:18 hobbs Exp $
d15 5
a19 2
set ::tcltest::testConfig(testwinevent) \
	[llength [info commands testwinevent]]
d21 1
a21 1
catch {testwinevent debug 1}
d49 1
a49 1
	after 150 {afterbody}
d53 1
a53 1
}
d58 1
a58 1
}
d74 1
a74 1
test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt testwinevent} {
d83 1
a83 1
test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt testwinevent} {
d92 1
a92 1
test winDialog-5.1 {GetFileName: no arguments} {nt testwinevent} {
d101 1
a101 1
test winDialog-5.4 {GetFileName: many arguments} {nt testwinevent} {
d110 1
a110 1
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
d119 1
a119 1
test winDialog-5.8 {GetFileName: extension begins with .} {nt testwinevent} {
d129 3
a131 3
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt testwinevent} {
d137 3
a139 3
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
test winDialog-5.10 {GetFileName: file types} {nt testwinevent} {
d154 1
a154 1
test winDialog-5.12 {GetFileName: initial directory} {nt testwinevent} {
d169 1
a169 1
test winDialog-5.14 {GetFileName: initial file} {nt testwinevent} {
d176 2
a177 2
    string totitle $x
} [string totitle [file join [pwd] "12x 456"]]
d187 1
a187 1
test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} {
d192 2
a193 2
    string totitle $x
} [string totitle [string range [file join [pwd] $a] 0 257]]
d205 1
a205 1
test winDialog-5.18 {GetFileName: title} {nt testwinevent} {
d213 1
a213 1
test winDialog-5.19 {GetFileName: no filter specified} {nt testwinevent} {
d240 1
a240 1
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt testwinevent} {
d250 1
a250 1
test winDialog-5.23 {GetFileName: call GetSaveFileName} {nt testwinevent} {
d260 1
a260 1
test winDialog-5.24 {GetFileName: convert \ to /} {nt testwinevent} {
d279 1
a279 1
test winDialog-9.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt testwinevent} {
d288 1
a288 1
test winDialog-9.3 {Tk_ChooseDirectoryObjCmd: many arguments} {nt testwinevent} {
d301 1
a301 1
	Tcl_GetIndexFromObj() == TCL_OK} {nt testwinevent} {
d311 1
a311 1
test winDialog-9.7 {Tk_ChooseDirectoryObjCmd: -initialdir} {nt testwinevent} {
d328 1
a328 1
catch {testwinevent debug 0}
@


1.5.4.1
log
@        * Merged in updates from HEAD branch.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.6 2001/04/04 06:47:25 hobbs Exp $
d129 2
a130 2
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
d137 2
a138 2
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
d176 2
a177 2
    string totitle $x
} [string totitle [file join [pwd] "12x 456"]]
d192 2
a193 2
    string totitle $x
} [string totitle [string range [file join [pwd] $a] 0 257]]
@


1.4
log
@	* 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
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.3 2000/04/08 06:59:37 hobbs Exp $
d100 1
a100 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
d109 1
a109 1
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
@


1.4.2.1
log
@see ChangeLog for specific file details
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.6 2001/04/04 06:47:25 hobbs Exp $
d129 2
a130 2
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
d137 2
a138 2
    string totitle $x
} [string totitle [file join [pwd] bar.foo]]
d176 2
a177 2
    string totitle $x
} [string totitle [file join [pwd] "12x 456"]]
d192 2
a193 2
    string totitle $x
} [string totitle [string range [file join [pwd] $a] 0 257]]
@


1.3
log
@	* tests/winDialog.test: removed knownBug constraint from 5.16
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.2 1999/04/16 01:51:43 stanton Exp $
d29 1
d31 1
a31 1
    after 1 "$arg"
d45 4
d80 1
a80 1
    set x	
d89 1
a89 1
    set x	
d250 1
a250 1
test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} {
d260 1
a260 1
test winDialog-5.22 {GetFileName: convert \ to /} {nt} {
d269 3
a271 2
test winDialog-8.1 {OFNHookProc} {nt} {
} {}
d273 1
a273 2
test winDialog-6.1 {MakeFilter} {nt} {
} {}
d275 5
a279 1
test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
d285 1
a285 1
test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
d288 4
a291 2
test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
    start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
d296 2
a297 2
test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \
	{nt} {
d300 2
a301 2
test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \
	{nt} {
d307 2
a308 2
test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \
	{nt} {
d311 1
a311 1
test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} {
d320 2
a321 3
test winDialog-5.13 \
	{Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \
	{nt} {
a327 2
test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}

a332 11











@


1.2
log
@* Merged 8.1 branch into the main trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.7 1999/03/26 00:08:11 hershey Exp $
d182 1
a182 1
test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} {
@


1.1
log
@file winDialog.test was initially added on branch core-8-1-branch.
@
text
@d1 335
@


1.1.2.1
log
@initial tk8.1a2 version
@
text
@a0 316
# This file is a Tcl script to test the Windows specific behavior of
# the common dialog boxes.  It is organized in the standard
# fashion for Tcl tests.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# SCCS: @@(#) winDialog.test 1.4 97/08/06 18:19:56

if {$tcl_platform(os) != "Windows NT"} {
    return 
}

if {[info procs test] != "test"} {
    source defs
}

set testConfig(interactive)	[info exists INTERACTIVE]

testwinevent debug 1

eval destroy [winfo children .] 
wm geometry . {}
raise .

proc start {arg} {
    set ::tk_dialog 0

    after 1 "$arg"
}

proc then {cmd} {
    set ::command $cmd
    set ::dialogresult {}

    afterbody
    vwait ::dialogresult
    return $::dialogresult
}

proc afterbody {} {
    if {$::tk_dialog == 0} {
	after 100 {afterbody}
	return
    }
    uplevel #0 {set dialogresult [eval $command]}
}    

proc Click {button} {
    testwinevent $::tk_dialog $button WM_LBUTTONDOWN 1 0x000a000b
    testwinevent $::tk_dialog $button WM_LBUTTONUP 0 0x000a000b
}	    

proc GetText {button} {
    return [testwinevent $::tk_dialog $button WM_GETTEXT]
}

proc SetText {button text} {
    return [testwinevent $::tk_dialog $button WM_SETTEXT $text]
}

test winDialog-1.1 {Tk_ChooseColorObjCmd} {
} {}

test winDialog-2.1 {ColorDlgHookProc} {
} {}

test winDialog-3.1 {Tk_GetOpenFileObjCmd} {
    start {tk_getOpenFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-4.1 {Tk_GetSaveFileObjCmd} {
    start {tk_getSaveFile}
    then {
	set x [GetText 2]
	Click 2
    }
    set x	
} {Cancel}

test winDialog-5.1 {GetFileName: no arguments} {
    start {tk_getOpenFile -title Open}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {GetFileName: one argument} {
    list [catch {tk_getOpenFile -foo} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.4 {GetFileName: many arguments} {
    start {tk_getOpenFile -initialdir c:/ -parent . -title test -initialfile foo}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {
    list [catch {tk_getOpenFile -foo bar -abc} msg] $msg
} {1 {bad option "-foo": must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent, or -title}}
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {
    start {tk_getOpenFile -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {GetFileName: valid option, but missing value} {
    list [catch {tk_getOpenFile -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.8 {GetFileName: extension begins with .} {
#    if (string[0] == '.') {
#	string++;
#    }

    start {set x [tk_getSaveFile -defaultextension .foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {
    start {set x [tk_getSaveFile -defaultextension foo -title Save]}
    then {
	SetText 0x480 bar
	Click 1
    }
    set x
} [file join [pwd] bar.foo]
test winDialog-5.10 {GetFileName: file types} {
#	    case FILE_TYPES: 

    start {tk_getSaveFile -filetypes {{"foo files" .foo FOOF}} -title Foo}
    then {
	set x [GetText 0x470]
	Click cancel
    }
    set x
} {foo files (*.foo)}
test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {
#		if (MakeFilter(interp, string, &utfFilterString) != TCL_OK) 

    list [catch {tk_getSaveFile -filetypes {{"foo" .foo FOO}}} msg] $msg
} {1 {bad Macintosh file type "FOO"}}
test winDialog-5.12 {GetFileName: initial directory} {
#	    case FILE_INITDIR: 

    start {set x [tk_getSaveFile -initialdir c:/ -initialfile "12x 455" -title Foo]}
    then {
	Click 1
    }
    set x
} {C:/12x 455}
test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    
    list [catch {tk_getOpenFile -initialdir ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
test winDialog-5.14 {GetFileName: initial file} {
#	    case FILE_INITFILE: 

    start {set x [tk_getSaveFile -initialfile "12x 456" -title Foo]}
    then {
	Click 1
    }
    set x
} [file join [pwd] "12x 456"]
test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {
#		if (Tcl_TranslateFileName(interp, string, &ds) == NULL) 
    list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
append a $a
append a $a
append a $a
append a $a
test winDialog-5.16 {GetFileName: initial file: long name} {
    start {set x [tk_getSaveFile -initialfile $a -title Long]}
    then {
	Click 1
    }
    set x
} [string range [file join [pwd] $a] 0 257]
test winDialog-5.17 {GetFileName: parent} {
#	    case FILE_PARENT: 

    toplevel .t
    set x 0
    start {tk_getOpenFile -parent .t -title Parent; set x 1}
    then {
	destroy .t
    }
    set x
} {1}
test winDialog-5.18 {GetFileName: title} {
#	    case FILE_TITLE: 
    
    start {tk_getOpenFile -title Narf}
    then {
	Click 2
    }
} {0}
test winDialog-5.19 {GetFileName: no filter specified} {
#    if (ofn.lpstrFilter == NULL) 

    start {tk_getOpenFile -title Filter} 
    then {
	set x [GetText 0x470]
	Click 2
    }
    set x
} {All Files (*.*)}
test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {
#    if (Tk_WindowId(parent) == None) 

    toplevel .t
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.21 {GetFileName: parent HWND already exists} {
    toplevel .t
    update
    start {tk_getOpenFile -parent .t -title Open}
    then {
	destroy .t
    }
} {}
test winDialog-5.22 {GetFileName: call GetOpenFileName} {
#	    winCode = GetOpenFileName(&ofn);
    
    start {tk_getOpenFile -title Open}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Open}
test winDialog-5.22 {GetFileName: call GetSaveFileName} {
#	    winCode = GetSaveFileName(&ofn);

    start {tk_getSaveFile -title Save}
    then {
	set x [GetText 1]
	Click 2
    }
    set x
} {&Save}
test winDialog-5.22 {GetFileName: convert \ to /} {
    start {set x [tk_getSaveFile -title Back]}
    then {
	SetText 0x480 "c:\\12x 457"
	Click 1
    }
    set x
} {c:/12x 457}

test winDialog-8.1 {OFNHookProc} {
} {}

test winDialog-6.1 {MakeFilter} {
} {}

test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {
    start {tk_chooseDirectory}
    then {
	Click cancel
    }
} {0}
test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {
    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} {
    start {tk_chooseDirectory -initialdir c:/ -mustexist 1 -parent . -title test}
    then {
	Click cancel
    }
} {0}
test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} {
    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} {
    start {tk_chooseDirectory -title bar}
    then {
	Click cancel
    }
} {0}
test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} {
    list [catch {tk_chooseDirectory -initialdir bar -title} msg] $msg
} {1 {value for "-title" missing}}
test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {
#	    case DIR_INITIAL: 

    start {set x [tk_chooseDirectory -initialdir c:/ -title Foo]}
    then {
	Click 1
    }
    string tolower [set x]
} {c:/}
test winDialog-5.13 {Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} {
#		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} {
} {}

testwinevent debug 0
@


1.1.2.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d10 1
a10 1
# RCS: @@(#) $Id$
@


1.1.2.3
log
@Updated the testsuite to use "test" namespace and commandline args
to control verbose  level and which tests get run.  Tests now work from
any working dir.
@
text
@a5 2
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
d7 4
a10 1
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.2 1998/09/30 02:19:06 stanton Exp $
a12 1
    puts "skipping: Windows NT only tests..."
d16 2
a17 2
if {[lsearch [namespace children] ::test] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
d20 1
a20 1
set ::test::testConfig(interactive)	[info exists INTERACTIVE]
a316 4

# cleanup
::test::cleanupTests
return
@


1.1.2.4
log
@changed all and defs to print stats at end of all tests.
blocked one test out of winDialog.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.3 1999/03/11 18:51:21 hershey Exp $
d182 1
a182 1
test winDialog-5.16 {GetFileName: initial file: long name} {knownBug} {
@


1.1.2.5
log
@- changed ::test to ::tcltest
- made many tests more atomic (still more work to do here)
- defs.tcl is now identicle for tcl and tk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.4 1999/03/14 01:22:53 hershey Exp $
d11 3
a13 3
if {[info command testwinevent] == ""} {
    puts "skipping: tests require the testwinevent command"
    return
d16 1
a16 1
if {[lsearch [namespace children] ::tcltest] == -1} {
d20 2
d64 1
a64 1
test winDialog-1.1 {Tk_ChooseColorObjCmd} {nt} {
d67 1
a67 1
test winDialog-2.1 {ColorDlgHookProc} {nt} {
d70 1
a70 1
test winDialog-3.1 {Tk_GetOpenFileObjCmd} {nt} {
d79 1
a79 1
test winDialog-4.1 {Tk_GetSaveFileObjCmd} {nt} {
d88 1
a88 1
test winDialog-5.1 {GetFileName: no arguments} {nt} {
d94 1
a94 1
test winDialog-5.2 {GetFileName: one argument} {nt} {
d97 1
a97 1
test winDialog-5.4 {GetFileName: many arguments} {nt} {
d103 1
a103 1
test winDialog-5.5 {GetFileName: Tcl_GetIndexFromObj() != TCL_OK} {nt} {
d106 1
a106 1
test winDialog-5.6 {GetFileName: Tcl_GetIndexFromObj() == TCL_OK} {nt} {
d112 1
a112 1
test winDialog-5.7 {GetFileName: valid option, but missing value} {nt} {
d115 1
a115 1
test winDialog-5.8 {GetFileName: extension begins with .} {nt} {
d127 1
a127 1
test winDialog-5.9 {GetFileName: extension doesn't begin with .} {nt} {
d135 1
a135 1
test winDialog-5.10 {GetFileName: file types} {nt} {
d145 1
a145 1
test winDialog-5.11 {GetFileName: file types: MakeFilter() fails} {nt} {
d150 1
a150 1
test winDialog-5.12 {GetFileName: initial directory} {nt} {
d159 1
a159 2
test winDialog-5.13 {GetFileName: initial directory: Tcl_TranslateFilename()} \
	{nt} {
d164 1
a164 1
test winDialog-5.14 {GetFileName: initial file} {nt} {
d173 1
a173 1
test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
d182 1
a182 1
test winDialog-5.16 {GetFileName: initial file: long name} {knownBug nt} {
d189 1
a189 1
test winDialog-5.17 {GetFileName: parent} {nt} {
d200 1
a200 1
test winDialog-5.18 {GetFileName: title} {nt} {
d208 1
a208 1
test winDialog-5.19 {GetFileName: no filter specified} {nt} {
d218 1
a218 1
test winDialog-5.20 {GetFileName: parent HWND doesn't yet exist} {nt} {
d227 1
a227 1
test winDialog-5.21 {GetFileName: parent HWND already exists} {nt} {
d235 1
a235 1
test winDialog-5.22 {GetFileName: call GetOpenFileName} {nt} {
d245 1
a245 1
test winDialog-5.22 {GetFileName: call GetSaveFileName} {nt} {
d255 1
a255 1
test winDialog-5.22 {GetFileName: convert \ to /} {nt} {
d264 1
a264 1
test winDialog-8.1 {OFNHookProc} {nt} {
d267 1
a267 1
test winDialog-6.1 {MakeFilter} {nt} {
d270 1
a270 1
test winDialog-5.1 {Tk_ChooseDirectoryObjCmd: no arguments} {nt} {
d276 1
a276 1
test winDialog-5.2 {Tk_ChooseDirectoryObjCmd: one argument} {nt} {
d279 1
a279 1
test winDialog-5.4 {Tk_ChooseDirectoryObjCmd: many arguments} {nt} {
d285 1
a285 2
test winDialog-5.5 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() != TCL_OK} \
	{nt} {
d288 1
a288 2
test winDialog-5.6 {Tk_ChooseDirectoryObjCmd: Tcl_GetIndexFromObj() == TCL_OK} \
	{nt} {
d294 1
a294 2
test winDialog-5.7 {Tk_ChooseDirectoryObjCmd: valid option, but missing value} \
	{nt} {
d297 1
a297 1
test winDialog-5.12 {Tk_ChooseDirectoryObjCmd: initial directory} {nt} {
d306 1
a306 3
test winDialog-5.13 \
	{Tk_ChooseDirectoryObjCmd: initial directory: Tcl_TranslateFilename()} \
	{nt} {
d313 2
a314 1
test winDialog-7.1 {Tk_MessageBoxObjCmd} {emptyTest nt} {} {}
d319 1
a319 1
::tcltest::cleanupTests
a320 10










@


1.1.2.6
log
@lint:  changed a tcltest namespace variable name from tmpDir to
       workingDir.
changes:  made more tests atomic.
README is now updated to match new test suite features.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.5 1999/03/24 01:17:18 hershey Exp $
a323 1

@


1.1.2.7
log
@Now all test files that skip tests by returning early (which ideally they
shouldn't do) call ::tcltest::cleanupTests before returning.  The defs.tcl
file has one hew constraint:  userInteraction, used by tests that require
user interaction.  The next putback will include an updated version of the
"visual" test file to use this mechanism.
@
text
@d9 1
a9 5
# RCS: @@(#) $Id: winDialog.test,v 1.1.2.6 1999/03/24 02:55:12 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
a12 1
    ::tcltest::cleanupTests
d14 4
@


