diff options
| author | hobbs <hobbs> | 1999-10-29 03:04:16 (GMT) |
|---|---|---|
| committer | hobbs <hobbs> | 1999-10-29 03:04:16 (GMT) |
| commit | da3760e58b15f3d2c22dad2f2c5ea0e6bfca0792 (patch) | |
| tree | f8c56b634f90772216e513bf4a71a5671c37019e /library | |
| parent | 92efc11980dd19d497d47daca03f5082a28a63f4 (diff) | |
| download | tcl-da3760e58b15f3d2c22dad2f2c5ea0e6bfca0792.zip tcl-da3760e58b15f3d2c22dad2f2c5ea0e6bfca0792.tar.gz tcl-da3760e58b15f3d2c22dad2f2c5ea0e6bfca0792.tar.bz2 | |
* library/tcltest1.0/tcltest.tcl: updated makeFile to return
full pathname of file created
Diffstat (limited to 'library')
| -rw-r--r-- | library/tcltest/tcltest.tcl | 11 | ||||
| -rw-r--r-- | library/tcltest1.0/tcltest.tcl | 11 |
2 files changed, 10 insertions, 12 deletions
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl index 55631aa..3de4a31 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.17 1999/10/21 02:17:43 hobbs Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.18 1999/10/29 03:04:16 hobbs Exp $ package provide tcltest 1.0 @@ -1698,23 +1698,22 @@ proc ::tcltest::makeFile {contents name} { DebugPuts 3 "::tcltest::makeFile: putting $contents into $name" - set fd [open [file join $::tcltest::temporaryDirectory $name] w] + set fullName [file join $::tcltest::temporaryDirectory $name] + set fd [open $fullName w] fconfigure $fd -translation lf - if {[string equal \ - [string index $contents [expr {[string length $contents] - 1}]] \ - "\n"]} { + if {[string equal [string index $contents end] "\n"]} { puts -nonewline $fd $contents } else { puts $fd $contents } close $fd - set fullName [file join [pwd] $name] if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { lappend ::tcltest::filesMade $fullName } + return $fullName } # ::tcltest::removeFile -- diff --git a/library/tcltest1.0/tcltest.tcl b/library/tcltest1.0/tcltest.tcl index 55631aa..3de4a31 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.17 1999/10/21 02:17:43 hobbs Exp $ +# RCS: @(#) $Id: tcltest.tcl,v 1.18 1999/10/29 03:04:16 hobbs Exp $ package provide tcltest 1.0 @@ -1698,23 +1698,22 @@ proc ::tcltest::makeFile {contents name} { DebugPuts 3 "::tcltest::makeFile: putting $contents into $name" - set fd [open [file join $::tcltest::temporaryDirectory $name] w] + set fullName [file join $::tcltest::temporaryDirectory $name] + set fd [open $fullName w] fconfigure $fd -translation lf - if {[string equal \ - [string index $contents [expr {[string length $contents] - 1}]] \ - "\n"]} { + if {[string equal [string index $contents end] "\n"]} { puts -nonewline $fd $contents } else { puts $fd $contents } close $fd - set fullName [file join [pwd] $name] if {[lsearch -exact $::tcltest::filesMade $fullName] == -1} { lappend ::tcltest::filesMade $fullName } + return $fullName } # ::tcltest::removeFile -- |