Tcl Source Code

Artifact [ec0bff9a54]
Login

Artifact ec0bff9a545e53b0492450a5c21cffafae2c3a9d:

Attachment "winsearch.patch" to ticket [1c6f6503d4] added by danckaert 2017-05-24 07:34:33. (unpublished)
diff --git a/library/init.tcl b/library/init.tcl
index a202054..9630cb0 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -633,13 +633,6 @@ proc auto_execok name {
 
     set shellBuiltins [list cls copy date del dir echo erase md mkdir \
 	    mklink rd ren rename rmdir start time type ver vol]
-    if {[info exists env(PATHEXT)]} {
-	# Add an initial ; to have the {} extension check first.
-	set execExtensions [split ";$env(PATHEXT)" ";"]
-    } else {
-	set execExtensions [list {} .com .exe .bat .cmd]
-    }
-
     if {[string tolower $name] in $shellBuiltins} {
 	# When this is command.com for some reason on Win2K, Tcl won't
 	# exec it unless the case is right, which this corrects.  COMSPEC
@@ -651,48 +644,13 @@ proc auto_execok name {
 	return [set auto_execs($name) [list $cmd /c $name]]
     }
 
-    if {[llength [file split $name]] != 1} {
-	foreach ext $execExtensions {
-	    set file ${name}${ext}
-	    if {[file exists $file] && ![file isdirectory $file]} {
-		return [set auto_execs($name) [list $file]]
-	    }
-	}
-	return ""
-    }
-
-    set path "[file dirname [info nameof]];.;"
-    if {[info exists env(WINDIR)]} {
-	set windir $env(WINDIR)
-    }
-    if {[info exists windir]} {
-	if {$tcl_platform(os) eq "Windows NT"} {
-	    append path "$windir/system32;"
-	}
-	append path "$windir/system;$windir;"
+    try {
+        tcl::winsearchpath $name
+    } on error {} {
+        return ""
+    } on ok {result} {
+        return [set auto_execs($name) [list [file join $result]]]
     }
-
-    foreach var {PATH Path path} {
-	if {[info exists env($var)]} {
-	    append path ";$env($var)"
-	}
-    }
-
-    foreach ext $execExtensions {
-	unset -nocomplain checked
-	foreach dir [split $path {;}] {
-	    # Skip already checked directories
-	    if {[info exists checked($dir)] || ($dir eq "")} {
-		continue
-	    }
-	    set checked($dir) {}
-	    set file [file join $dir ${name}${ext}]
-	    if {[file exists $file] && ![file isdirectory $file]} {
-		return [set auto_execs($name) [list $file]]
-	    }
-	}
-    }
-    return ""
 }
 
 } else {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 98c7ed5..b461b01 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -640,6 +640,12 @@ TclpSetVariables(
      */
 
     Tcl_SetVar2(interp, "tcl_platform","pathSeparator", ";", TCL_GLOBAL_ONLY);
+
+    /*
+     * Create helper function for [auto_execok].
+     */
+    Tcl_CreateObjCommand(interp, "::tcl::winsearchpath", TclWinSearchPathObjCmd,
+                         NULL, NULL);
 }
 
 /*
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 43799d0..7624af3 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -82,6 +82,9 @@ MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
 MODULE_SCOPE int	TclWinSymLinkDelete(const TCHAR *LinkOriginal,
 			    int linkOnly);
 MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);
+MODULE_SCOPE int	TclWinSearchPathObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
 MODULE_SCOPE void	TclWinFreeAllocCache(void);
 MODULE_SCOPE void	TclFreeAllocCache(void *);
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 5246d53..ac08653 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -1236,6 +1236,48 @@ HasConsole(void)
 /*
  *--------------------------------------------------------------------
  *
+ * TclWinSearchPathObjCmd --
+ *
+ *      Search for the specified program and return the full pathname.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+int TclWinSearchPathObjCmd(ClientData cd,
+                           Tcl_Interp *interp,
+                           int objc,
+                           Tcl_Obj *const objv[])
+{
+    int code;
+    char path[MAX_PATH * TCL_UTF_MAX];
+    char* name;
+    Tcl_DString buffer;
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "name");
+	return TCL_ERROR;
+    }
+    Tcl_DStringInit(&buffer);
+    name = Tcl_TranslateFileName(interp, Tcl_GetString(objv[1]), &buffer);
+    if (name == NULL) {
+        code = TCL_ERROR;
+    } else if (ApplicationType(interp, name, path) == APPL_NONE) {
+        code = TCL_ERROR;
+    } else {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj(path, -1));
+        code = TCL_OK;
+    }
+    Tcl_DStringFree(&buffer);
+    return code;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
  * ApplicationType --
  *
  *	Search for the specified program and identify if it refers to a DOS,