From 335c1f78124d678298612ab09fed880c7042aebc Mon Sep 17 00:00:00 2001 From: jenn Date: Thu, 27 Jan 2000 23:44:01 +0000 Subject: * library/tcltest1.0/tcltest.tcl: Changed NormalizePath to normalizePath and exported it as a public proc. This proc creates an absolute path given the name of the variable containing the path to modify. The path is modified in place. * library/tcltest1.0/pkgIndex.tcl: Added normalizePath. * tests/all.tcl: Changed code to use normalizePath. --- ChangeLog | 9 +++++++++ library/tcltest/pkgIndex.tcl | 3 ++- library/tcltest/tcltest.tcl | 12 ++++++------ library/tcltest1.0/pkgIndex.tcl | 3 ++- library/tcltest1.0/tcltest.tcl | 12 ++++++------ tests/all.tcl | 11 ++--------- 6 files changed, 27 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index 4fb7de7..59bcdd8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2000-01-27 Jennifer Hom + + * library/tcltest1.0/tcltest.tcl: Changed NormalizePath to + normalizePath and exported it as a public proc. This proc + creates an absolute path given the name of the variable containing + the path to modify. The path is modified in place. + * library/tcltest1.0/pkgIndex.tcl: Added normalizePath. + * tests/all.tcl: Changed code to use normalizePath. + 2000-01-27 Eric Melski * tests/pkgMkIndex.test: diff --git a/library/tcltest/pkgIndex.tcl b/library/tcltest/pkgIndex.tcl index 205cbbb..7a58882 100644 --- a/library/tcltest/pkgIndex.tcl +++ b/library/tcltest/pkgIndex.tcl @@ -14,4 +14,5 @@ package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \ ::tcltest::removeDirectory ::tcltest::removeFile \ ::tcltest::restoreState ::tcltest::saveState ::tcltest::test \ ::tcltest::threadReap ::tcltest::viewFile ::tcltest::grep \ - ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] + ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands \ + ::tcltest::normalizePath }}}] diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 3f09055..950f3f4 100644 --- a/library/tcltest/tcltest.tcl +++ b/library/tcltest/tcltest.tcl @@ -12,7 +12,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.20 1999/11/23 22:59:13 stanton Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.21 2000/01/27 23:44:07 jenn Exp $ package provide tcltest 1.0 @@ -24,7 +24,7 @@ namespace eval tcltest { set procList [list test cleanupTests saveState restoreState \ normalizeMsg makeFile removeFile makeDirectory removeDirectory \ viewFile bytestring safeFetch threadReap getMatchingFiles \ - loadTestedCommands] + loadTestedCommands normalizePath] foreach proc $procList { namespace export $proc } @@ -803,7 +803,7 @@ proc ::tcltest::CheckDirectory {rw dir errMsg} { } } -# ::tcltest::NormalizePath -- +# ::tcltest::normalizePath -- # # This procedure resolves any symlinks in the path thus creating a # path without internal redirection. It assumes that the incoming @@ -816,7 +816,7 @@ proc ::tcltest::CheckDirectory {rw dir errMsg} { # The path is modified in place. # -proc ::tcltest::NormalizePath {pathVar} { +proc ::tcltest::normalizePath {pathVar} { upvar $pathVar path set oldpwd [pwd] @@ -1016,7 +1016,7 @@ proc ::tcltest::processCmdLineArgs {} { file mkdir $::tcltest::temporaryDirectory } - NormalizePath ::tcltest::temporaryDirectory + normalizePath ::tcltest::temporaryDirectory # Set the ::tcltest::testsDirectory to the arg of -testdir, if # given. @@ -1041,7 +1041,7 @@ proc ::tcltest::processCmdLineArgs {} { exit 1 } - NormalizePath ::tcltest::testsDirectory + normalizePath ::tcltest::testsDirectory # Save the names of files that already exist in # the output directory. diff --git a/library/tcltest1.0/pkgIndex.tcl b/library/tcltest1.0/pkgIndex.tcl index 205cbbb..7a58882 100644 --- a/library/tcltest1.0/pkgIndex.tcl +++ b/library/tcltest1.0/pkgIndex.tcl @@ -14,4 +14,5 @@ package ifneeded tcltest 1.0 [list tclPkgSetup $dir tcltest 1.0 \ ::tcltest::removeDirectory ::tcltest::removeFile \ ::tcltest::restoreState ::tcltest::saveState ::tcltest::test \ ::tcltest::threadReap ::tcltest::viewFile ::tcltest::grep \ - ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands}}}] + ::tcltest::getMatchingFiles ::tcltest::loadTestedCommands \ + ::tcltest::normalizePath }}}] diff --git a/library/tcltest1.0/tcltest.tcl b/library/tcltest1.0/tcltest.tcl index 3f09055..950f3f4 100644 --- a/library/tcltest1.0/tcltest.tcl +++ b/library/tcltest1.0/tcltest.tcl @@ -12,7 +12,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.tcl,v 1.20 1999/11/23 22:59:13 stanton Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.21 2000/01/27 23:44:07 jenn Exp $ package provide tcltest 1.0 @@ -24,7 +24,7 @@ namespace eval tcltest { set procList [list test cleanupTests saveState restoreState \ normalizeMsg makeFile removeFile makeDirectory removeDirectory \ viewFile bytestring safeFetch threadReap getMatchingFiles \ - loadTestedCommands] + loadTestedCommands normalizePath] foreach proc $procList { namespace export $proc } @@ -803,7 +803,7 @@ proc ::tcltest::CheckDirectory {rw dir errMsg} { } } -# ::tcltest::NormalizePath -- +# ::tcltest::normalizePath -- # # This procedure resolves any symlinks in the path thus creating a # path without internal redirection. It assumes that the incoming @@ -816,7 +816,7 @@ proc ::tcltest::CheckDirectory {rw dir errMsg} { # The path is modified in place. # -proc ::tcltest::NormalizePath {pathVar} { +proc ::tcltest::normalizePath {pathVar} { upvar $pathVar path set oldpwd [pwd] @@ -1016,7 +1016,7 @@ proc ::tcltest::processCmdLineArgs {} { file mkdir $::tcltest::temporaryDirectory } - NormalizePath ::tcltest::temporaryDirectory + normalizePath ::tcltest::temporaryDirectory # Set the ::tcltest::testsDirectory to the arg of -testdir, if # given. @@ -1041,7 +1041,7 @@ proc ::tcltest::processCmdLineArgs {} { exit 1 } - NormalizePath ::tcltest::testsDirectory + normalizePath ::tcltest::testsDirectory # Save the names of files that already exist in # the output directory. diff --git a/tests/all.tcl b/tests/all.tcl index 1b13adb..aca74f8 100644 --- a/tests/all.tcl +++ b/tests/all.tcl @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: all.tcl,v 1.8 1999/12/04 06:16:48 hobbs Exp $ +# RCS: @(#) $Id: all.tcl,v 1.9 2000/01/27 23:44:09 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -18,14 +18,7 @@ set ::tcltest::testSingleFile false set ::tcltest::testsDirectory [file dir [info script]] # We need to ensure that the testsDirectory is absolute -# -if {[string equal relative [file pathtype $::tcltest::testsDirectory]]} { - set cwd [pwd] - cd $::tcltest::testsDirectory - set ::tcltest::testsDirectory [pwd] - cd $cwd - unset cwd -} +::tcltest::normalizePath ::tcltest::testsDirectory puts stdout "Tcl $tcl_patchLevel tests running in interp: [info nameofexecutable]" puts stdout "Tests running in working dir: $::tcltest::testsDirectory" -- cgit v0.12