From f95adc31b2b6a26b68eaafb67a0438c3989bc458 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 Jul 2001 20:57:02 +0000 Subject: * tests/unixInit.test (unixInit-2.8): Corrected test for all absolute pathnames in library path when executable is installed near root directory to use correct development directory layout. [Bug 438014] * tests/unixInit.test (unixInit-2.9): * unix/tclUnixInit.c (TclpInitLibraryPath): * win/tclWinInit.c (TclpInitLibraryPath): Corrected buggy construction of search path entries relative to executable. Added test for bad construction. [Bug 438014] --- ChangeLog | 13 +++++++++++++ tests/unixInit.test | 24 +++++++++++++++++++++--- unix/tclUnixInit.c | 14 +++++++++++++- win/tclWinInit.c | 14 +++++++++++++- 4 files changed, 60 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index 98ff7b6..5c1e273 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2001-07-02 Don Porter + + * tests/unixInit.test (unixInit-2.8): Corrected test for all + absolute pathnames in library path when executable is installed + near root directory to use correct development directory layout. + [Bug 438014] + + * tests/unixInit.test (unixInit-2.9): + * unix/tclUnixInit.c (TclpInitLibraryPath): + * win/tclWinInit.c (TclpInitLibraryPath): Corrected buggy + construction of search path entries relative to executable. + Added test for bad construction. [Bug 438014] + 2001-06-28 Miguel Sofer * generic/tclNamesp.c: Correction to faulty patch from [Bug: 231259] diff --git a/tests/unixInit.test b/tests/unixInit.test index 4d62f86..8370d6a 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.16 2001/06/28 09:54:32 dkf Exp $ +# RCS: @(#) $Id: unixInit.test,v 1.17 2001/07/02 20:57:02 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -194,8 +194,8 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} { file mkdir /tmp/sparkly file copy $::tcltest::tcltest /tmp/sparkly/tcltest - file mkdir /tmp/library/tcl[info tclversion] - close [open /tmp/library/tcl[info tclversion]/init.tcl w] + file mkdir /tmp/library/ + close [open /tmp/library/init.tcl w] set allAbsolute 1 foreach dir [getlibpath /tmp/sparkly/tcltest] { @@ -206,6 +206,24 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} {unixOnly} { file delete -force /tmp/library set allAbsolute } 1 +test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} { + unixOnly} { + # Checking for Bug 438014 + file delete -force /tmp/sparkly + file delete -force /tmp/library + file mkdir /tmp/sparkly + file copy $::tcltest::tcltest /tmp/sparkly/tcltest + + file mkdir /tmp/library/ + close [open /tmp/library/init.tcl w] + + set x [lrange [getlibpath /tmp/sparkly/tcltest] 0 4] + + file delete -force /tmp/sparkly + file delete -force /tmp/library + set x +} [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \ + /tmp/library /library /tcl[info patchlevel]/library] test unixInit-3.1 {TclpSetInitialEncodings} {unixOnly installedTcl} { set env(LANG) C diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index aaaa811..3fd7d1f 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.21 2001/01/04 21:30:49 dgp Exp $ + * RCS: @(#) $Id: tclUnixInit.c,v 1.22 2001/07/02 20:57:02 dgp Exp $ */ #include "tclInt.h" @@ -290,43 +290,55 @@ CONST char *path; /* Path to the executable in native if (path != NULL) { Tcl_SplitPath(path, &pathc, &pathv); if (pathc > 2) { + str = pathv[pathc - 2]; pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); + pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = installLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 2) { + str = pathv[pathc - 2]; pathv[pathc - 2] = "library"; path = Tcl_JoinPath(pathc - 1, pathv, &ds); + pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = "library"; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = developLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 4) { + str = pathv[pathc - 4]; pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); + pathv[pathc - 4] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); diff --git a/win/tclWinInit.c b/win/tclWinInit.c index 125afcc..d657784 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.25 2001/01/04 21:30:49 dgp Exp $ + * RCS: @(#) $Id: tclWinInit.c,v 1.26 2001/07/02 20:57:02 dgp Exp $ */ #include "tclWinInt.h" @@ -237,43 +237,55 @@ TclpInitLibraryPath(path) if (path != NULL) { Tcl_SplitPath(path, &pathc, &pathv); if (pathc > 2) { + str = pathv[pathc - 2]; pathv[pathc - 2] = installLib; path = Tcl_JoinPath(pathc - 1, pathv, &ds); + pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = installLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 2) { + str = pathv[pathc - 2]; pathv[pathc - 2] = "library"; path = Tcl_JoinPath(pathc - 1, pathv, &ds); + pathv[pathc - 2] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = "library"; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 3) { + str = pathv[pathc - 3]; pathv[pathc - 3] = developLib; path = Tcl_JoinPath(pathc - 2, pathv, &ds); + pathv[pathc - 3] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); } if (pathc > 4) { + str = pathv[pathc - 4]; pathv[pathc - 4] = developLib; path = Tcl_JoinPath(pathc - 3, pathv, &ds); + pathv[pathc - 4] = str; objPtr = Tcl_NewStringObj(path, Tcl_DStringLength(&ds)); Tcl_ListObjAppendElement(NULL, pathPtr, objPtr); Tcl_DStringFree(&ds); -- cgit v0.12