Fix for [46c83f60] (relative paths ignored in tk_getOpenFile/tk_getSaveFile on Vista+). Added tests for -initialdir option.

2 files changed, 213 insertions, 11 deletions

diff --git a/tests/winDialog.test b/tests/winDialog.test
index b7847a5..6b8af59 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -339,6 +339,7 @@ test winDialog-5.11 {GetFileName: initial directory} -constraints {
     }
     return $x
 } -result [file join [initialdir] "12x 455"]
+
 test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -constraints {
     nt
 } -body {
@@ -346,6 +347,198 @@ test winDialog-5.12 {GetFileName: initial directory: Tcl_TranslateFilename()} -c
 
     tk_getOpenFile -initialdir ~12x/455
 } -returnCodes error -result {user "12x" doesn't exist}
+
+test winDialog-5.12.1 {tk_getSaveFile: initial directory: ~} -constraints {
+    nt testwinevent
+} -body {
+    unset -nocomplain x
+    start {set x [tk_getSaveFile \
+                      -initialdir ~ \
+                      -initialfile "5 12 1" -title Foo]}
+    then {
+        Click ok
+    }
+    return $x
+} -result [file normalize [file join ~ "5 12 1"]]
+
+test winDialog-5.12.2 {tk_getSaveFile: initial directory: ~user} -constraints {
+    nt testwinevent DISABLED
+} -body {
+    # Note: this test is currently disabled because of a bug in file normalize
+    # for names of the form ~xxx that returns the wrong dir on Windows.
+    # In particular (in Win8 at least) it returns /users/Default instead
+    # of /users/USERNAME... 
+
+    unset -nocomplain x
+    start {set x [tk_getSaveFile \
+                      -initialdir ~$::env(USERNAME) \
+                      -initialfile "5 12 2" -title Foo]}
+    then {
+        Click ok
+    }
+    return $x
+} -result [file normalize [file join ~$::env(USERNAME) "5 12 2"]]
+
+test winDialog-5.12.3 {tk_getSaveFile: initial directory: .} -constraints {
+    nt testwinevent
+} -body {
+    # Windows remembers dirs from previous selections so use
+    # a subdir for this test, not [initialdir] itself
+    set newdir [tcltest::makeDirectory "5 12 3"]
+    set cur [pwd]
+    try {
+        cd $newdir
+        unset -nocomplain x
+        start {set x [tk_getSaveFile \
+                          -initialdir . \
+                          -initialfile "testfile" -title Foo]}
+        then {
+            Click ok
+        }
+    } finally {
+        cd $cur
+    }
+    string equal $x [file join $newdir testfile]
+} -result 1
+
+test winDialog-5.12.4 {tk_getSaveFile: initial directory: unicode} -constraints {
+    nt testwinevent
+} -body {
+    set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"]
+    unset -nocomplain x
+    start {set x [tk_getSaveFile \
+                      -initialdir $dir \
+                      -initialfile "testfile" -title Foo]}
+    then {
+        Click ok
+    }
+    string equal $x [file join $dir testfile]
+} -result 1
+
+test winDialog-5.12.5 {tk_getSaveFile: initial directory: nativename} -constraints {
+    nt testwinevent
+} -body {
+    unset -nocomplain x
+    start {set x [tk_getSaveFile \
+                      -initialdir [file nativename [initialdir]] \
+                      -initialfile "5 12 5" -title Foo]}
+    then {
+        Click ok
+    }
+    return $x
+} -result [file join [initialdir] "5 12 5"]
+
+test winDialog-5.12.6 {tk_getSaveFile: initial directory: relative} -constraints {
+    nt testwinevent
+} -body {
+    # Windows remembers dirs from previous selections so use
+    # a subdir for this test, not [initialdir] itself
+    set dir [tcltest::makeDirectory "5 12 6"]
+    set cur [pwd]
+    try {
+        cd [file dirname $dir]
+        unset -nocomplain x
+        start {set x [tk_getSaveFile \
+                          -initialdir "5 12 6" \
+                          -initialfile "testfile" -title Foo]}
+        then {
+            Click ok
+        }
+    } finally {
+        cd $cur
+    }
+    string equal $x [file join $dir testfile]
+} -result 1
+
+test winDialog-5.12.7 {tk_getOpenFile: initial directory: ~} -constraints {
+    nt testwinevent
+} -body {
+    set fn [file tail [lindex [glob ~/*] 0]]
+    unset -nocomplain x
+    start {set x [tk_getOpenFile \
+                      -initialdir ~ \
+                      -initialfile $fn -title Foo]}
+    then {
+        Click ok
+    }
+    string equal $x [file normalize [file join ~ $fn]]
+} -result 1
+
+test winDialog-5.12.8 {tk_getOpenFile: initial directory: .} -constraints {
+    nt testwinevent
+} -body {
+    # Windows remembers dirs from previous selections so use
+    # a subdir for this test, not [initialdir] itself
+    set newdir [tcltest::makeDirectory "5 12 8"]
+    set path [tcltest::makeFile "" "testfile" $newdir]
+    set cur [pwd]
+    try {
+        cd $newdir
+        unset -nocomplain x
+        start {set x [tk_getOpenFile \
+                          -initialdir . \
+                          -initialfile "testfile" -title Foo]}
+        then {
+            Click ok
+        }
+    } finally {
+        cd $cur
+    }
+    string equal $x $path
+} -result 1
+
+test winDialog-5.12.9 {tk_getOpenFile: initial directory: unicode} -constraints {
+    nt testwinevent
+} -body {
+    set dir [tcltest::makeDirectory "\u0167\u00e9\u015d\u0167"]
+    set path [tcltest::makeFile "" testfile $dir]
+    unset -nocomplain x
+    start {set x [tk_getOpenFile \
+                      -initialdir $dir \
+                      -initialfile "testfile" -title Foo]}
+    then {
+        Click ok
+    }
+    string equal $x $path
+} -result 1
+
+test winDialog-5.12.10 {tk_getOpenFile: initial directory: nativename} -constraints {
+    nt testwinevent
+} -body {
+    unset -nocomplain x
+    tcltest::makeFile "" "5 12 10" [initialdir]
+    start {set x [tk_getOpenFile \
+                      -initialdir [file nativename [initialdir]] \
+                      -initialfile "5 12 10" -title Foo]}
+    then {
+        Click ok
+    }
+    return $x
+} -result [file join [initialdir] "5 12 10"]
+
+test winDialog-5.12.11 {tk_getOpenFile: initial directory: relative} -constraints {
+    nt testwinevent
+} -body {
+    # Windows remembers dirs from previous selections so use
+    # a subdir for this test, not [initialdir] itself
+    set dir [tcltest::makeDirectory "5 12 11"]
+    set path [tcltest::makeFile "" testfile $dir]
+    set cur [pwd]
+    try {
+        cd [file dirname $dir]
+        unset -nocomplain x
+        start {set x [tk_getOpenFile \
+                          -initialdir [file tail $dir] \
+                          -initialfile "testfile" -title Foo]}
+        then {
+            Click ok
+        }
+    } finally {
+        cd $cur
+    }
+    string equal $x $path
+} -result 1
+
 test winDialog-5.13 {GetFileName: initial file} -constraints {
     nt testwinevent
 } -body {
diff --git a/win/tkWinDialog.c b/win/tkWinDialog.c
index dc385e3..0188296 100644
--- a/win/tkWinDialog.c
+++ b/win/tkWinDialog.c
@@ -1388,18 +1388,27 @@ static int GetFileNameVista(Tcl_Interp *interp, OFNOpts *optsPtr,
     }
 
     if (Tcl_DStringValue(&optsPtr->utfDirString)[0] != '\0') {
-        Tcl_DString dirString;
-	Tcl_WinUtfToTChar(Tcl_DStringValue(&optsPtr->utfDirString),
-               Tcl_DStringLength(&optsPtr->utfDirString), &dirString);
-        hr = ShellProcs.SHCreateItemFromParsingName(
-            (TCHAR *) Tcl_DStringValue(&dirString), NULL,
-            &IIDIShellItem, (void **) &dirIf);
-        /* XXX - Note on failure we do not raise error, simply ignore ini dir */
-        if (SUCCEEDED(hr)) {
-            /* Note we use SetFolder, not SetDefaultFolder - see MSDN docs */
-            fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
+        Tcl_Obj *normPath, *iniDirPath;
+        iniDirPath = Tcl_NewStringObj(Tcl_DStringValue(&optsPtr->utfDirString), -1);
+        Tcl_IncrRefCount(iniDirPath);
+        normPath = Tcl_FSGetNormalizedPath(interp, iniDirPath);
+        /* XXX - Note on failures do not raise error, simply ignore ini dir */
+        if (normPath) {
+            const WCHAR *nativePath;
+            Tcl_IncrRefCount(normPath);
+            nativePath = Tcl_FSGetNativePath(normPath); /* Points INTO normPath*/
+            if (nativePath) {
+                hr = ShellProcs.SHCreateItemFromParsingName(
+                    nativePath, NULL,
+                    &IIDIShellItem, (void **) &dirIf);
+                if (SUCCEEDED(hr)) {
+                    /* Note we use SetFolder, not SetDefaultFolder - see MSDN */
+                    fdlgIf->lpVtbl->SetFolder(fdlgIf, dirIf); /* Ignore errors */
+                }
+            }
+            Tcl_DecrRefCount(normPath); /* ALSO INVALIDATES nativePath !! */
         }
-        Tcl_DStringFree(&dirString);
+        Tcl_DecrRefCount(iniDirPath);
     }
 
     oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);