diff options
-rw-r--r-- | ChangeLog | 12 | ||||
-rw-r--r-- | tests/unixInit.test | 20 | ||||
-rw-r--r-- | unix/tclUnixInit.c | 20 | ||||
-rw-r--r-- | win/tclWinInit.c | 19 |
4 files changed, 55 insertions, 16 deletions
@@ -1,5 +1,15 @@ -2000-12-14 Don Porter <dgp@users.sourceforge.net> +2001-01-04 Don Porter <dgp@users.sourceforge.net> + * tests/unixInit.test: + * unix/tclUnixInit.c (TclpInitLibraryPath): + * win/tclWinInit.c (TclpInitLibraryPath): Several entries in + the library path ($tcl_libPath) are determined relative to the + absolute path of the executable. When the executable is + installed in or near the root directory of the file system, + relative pathnames were being incorrectly generated, and in + the worst case, memory access violations were crashing the program. + [Bug 119416, Patch 102972] +2000-12-14 Don Porter <dgp@users.sourceforge.net> * generic/tclExecute.c: * tests/expr-old.test: Re-wrote Tcl's [expr rand()] and [expr srand($seed)] implementations, fixing a range error diff --git a/tests/unixInit.test b/tests/unixInit.test index 746114c..3017587 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.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: unixInit.test,v 1.13 2000/04/10 17:19:05 ericm Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.14 2001/01/04 21:30:49 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -150,6 +150,24 @@ test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} \ # would need test command to get defaultLibDir and compare it to # [lindex $auto_path end] } {} +test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} { + file delete -force /tmp/sparkly + file delete -force /tmp/lib + file mkdir /tmp/sparkly + file copy $::tcltest::tcltest /tmp/sparkly/tcltest + + file mkdir /tmp/lib/tcl[info tclversion] + close [open /tmp/lib/tcl[info tclversion]/init.tcl w] + + set allAbsolute 1 + foreach dir [getlibpath /tmp/sparkly/tcltest] { + set allAbsolute [expr {$allAbsolute \ + && [string equal absolute [file pathtype $dir]]}] + } + file delete -force /tmp/sparkly + file delete -force /tmp/lib + set allAbsolute +} 1 test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { set env(LANG) C diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index dcff38b..aaaa811 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclUnixInit.c,v 1.20 2000/10/31 00:48:53 hobbs Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.21 2001/01/04 21:30:49 dgp Exp $ */ #include "tclInt.h" @@ -281,44 +281,50 @@ CONST char *path; /* Path to the executable in native * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library) */ + + /* + * The variable path holds an absolute path. Take care not to + * overwrite pathv[0] since that might produce a relative path. + */ + if (path != NULL) { Tcl_SplitPath(path, &pathc, &pathv); - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = installLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = "library"; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = "library"; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 3) { pathv[pathc - 3] = developLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 3) { + if (pathc > 4) { pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 1f6d76f..125afcc 100644 --- a/win/tclWinInit.c +++ b/win/tclWinInit.c @@ -7,7 +7,7 @@ * Copyright (c) 1998-1999 by Scriptics Corporation. * All rights reserved. * - * RCS: @(#) $Id: tclWinInit.c,v 1.24 2000/07/26 01:27:58 davidg Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.25 2001/01/04 21:30:49 dgp Exp $ */ #include "tclWinInt.h" @@ -229,44 +229,49 @@ TclpInitLibraryPath(path) * (e.g. /usr/src/tcl8.2/unix/solaris-sparc/../../../tcl8.2/library) */ + /* + * The variable path holds an absolute path. Take care not to + * overwrite pathv[0] since that might produce a relative path. + */ + if (path != NULL) { Tcl_SplitPath(path, &pathc, &pathv); - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = installLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 2) { pathv[pathc - 2] = "library"; path = Tcl_JoinPath(pathc - 1, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 2) { + if (pathc > 3) { pathv[pathc - 3] = "library"; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 1) { + if (pathc > 3) { pathv[pathc - 3] = developLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } - if (pathc > 3) { + if (pathc > 4) { pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); |