Tcl Source Code

     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = (FsPath *)ckalloc(sizeof(FsPath));

    if (transPtr == pathPtr) {
	Tcl_GetStringFromObj(pathPtr, NULL);
	TclFreeInternalRep(pathPtr);
        transPtr = Tcl_DuplicateObj(pathPtr);
        fsPathPtr->filesystemEpoch = 0;
    } else {
        fsPathPtr->filesystemEpoch = TclFSEpoch();
    }
    Tcl_IncrRefCount(transPtr);
    fsPathPtr->translatedPathPtr = transPtr;

    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]
source [file join [file dirname [info script]] tcltests.tcl]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \

   glob -nocomplain -directory ~ -join * fileName-20.10
} -cleanup {
    cd $savewd
    removeDirectory isolate
    removeFile fileName-20.10 $s
    removeDirectory sub ~
} -result ~/sub/fileName-20.10


apply [list {} {
    test fileName-6d4e9d1af5bf5b7d {
	memory leak in SetFsPathFromAny

	Runs under both a TCL_DEBUG_MEM build and a -DPURIFY build for
	valgrind, which is useful since Valgrind provides information about the
	error location, but [memory] doesn't.
    } -setup {
	makeFile {puts "In script"} script

	if {[namespace which ::memory] eq {}} {
	    set memcheckcmd [list ::apply [list script {
		uplevel 1 $script
		return 0
	    } [namespace current]]]
	} else {
	    set memcheckcmd ::tcltests::scriptmemcheck
	}
    } -body {
	{*}$memcheckcmd {
	    set interp [interp create]
	    interp eval $interp {
		apply [list {} {
		    upvar 1 f f 

		    # A unique name so that no internal representation of this
		    # literal value has been picked up from any other script
		    # that has alredy been sourced into this interpreter.
		    set variableUniqueInTheEntireTclCodebase a
		    set name variableUniqueInTheEntireTclCodebase

		    # give the Tcl_Obj for "var1" an internal representation of
		    # type 'localVarNameType'.
		    set $name

		    set f [open variableUniqueInTheEntireTclCodebase w]
			try {
				puts $f {some data}
			} finally {
				close $f
			}

		    set f [open variableUniqueInTheEntireTclCodebase]
			try {
				read $f
			} finally {
				catch {file delete variableUniqueInTheEntireTclCodebase}
				close $f
			}
		} [namespace current]]
	    }
	    interp delete $interp
	}
    } -result 0
} [namespace current]]
    



# cleanup
catch {file delete -force C:/globTest}
cd [temporaryDirectory]
file delete -force globTest
cd $oldpwd
catch {removeDirectory tcl[pid]}

	    interp alias {} [namespace current]::tempdir {} [
		namespace current]::tempdir_alternate
	} else {
	    interp alias {} [namespace current]::tempdir {} ::tcl::file::tempdir
	}
    }


    # Stolen from dict.test
    proc scriptmemcheck script {
	set end [lindex [split [memory info] \n] 3 3]
	for {set i 0} {$i < 5} {incr i} {
	    uplevel 1 $script
	    set tmp $end
	    set end [lindex [split [memory info] \n] 3 3]
	}
	expr {$end - $tmp}
    }


    proc tempdir_alternate {} {
	close [file tempfile tempfile]
	set tmpdir [file dirname $tempfile]
	set execname [info nameofexecutable]
	regsub -all {[^[:alpha:][:digit:]]} $execname _ execname
	for {set i 0} {$i < 10000} {incr i} {