From 2a9cfcc7744dc99bb7f19869ccec28b275cca147 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 18 Aug 2009 14:44:21 +0000
Subject:         * generic/tclPathObj.c: Added NULL check to prevent crashes
 during         * tests/fileName.test:  [glob].  [Bug 2837800]

---
 ChangeLog            |  5 +++++
 generic/tclPathObj.c |  5 ++++-
 tests/fileName.test  | 34 +++++++++++++++++++++++++++++++++-
 3 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index e93139b..3351815 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-08-18  Don Porter  <dgp@users.sourceforge.net>
+
+	* generic/tclPathObj.c: Added NULL check to prevent crashes during
+	* tests/fileName.test:  [glob].  [Bug 2837800]
+
 2009-08-16  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* unix/dltest/pkge.c:  const addition
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 3c7cce5..6c368e5 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclPathObj.c,v 1.80 2009/03/27 19:17:54 dgp Exp $
+ * RCS: @(#) $Id: tclPathObj.c,v 1.81 2009/08/18 14:44:21 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1684,6 +1684,9 @@ Tcl_FSGetTranslatedPath(
 
 	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
 		    srcFsPathPtr->cwdPtr);
+	    if (translatedCwdPtr == NULL) {
+		return NULL;
+	    }
 
 	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
 		    &srcFsPathPtr->normPathPtr);
diff --git a/tests/fileName.test b/tests/fileName.test
index 78f2e58..6043b36 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fileName.test,v 1.59 2009/03/27 19:17:54 dgp Exp $
+# RCS: @(#) $Id: fileName.test,v 1.60 2009/08/18 14:44:21 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -1510,6 +1510,38 @@ test fileName-20.4 {Bug 1750300} -setup {
     removeDirectory foo
 } -result 0
 
+test fileName-20.5 {Bug 2837800} -setup {
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~foo $dd]
+    makeFile {} test $d
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob */test
+} -cleanup {
+    cd $savewd
+    removeFile test $d
+    removeDirectory ./~foo $dd
+    removeDirectory isolate
+} -result ~foo/test
+
+test fileName-20.6 {Bug 2837800} -setup {
+    # Recall that we have $env(HOME) set so that references
+    # to ~ point to [temporaryDirectory]
+    makeFile {} test ~
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~ $dd]
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob -nocomplain */test
+} -cleanup {
+    cd $savewd
+    removeDirectory ./~ $dd
+    removeDirectory isolate
+    removeFile test ~
+} -result {}
+
 # cleanup
 catch {file delete -force C:/globTest}
 cd [temporaryDirectory]
-- 
cgit v0.12