Tcl Source Code

Artifact 7b454b33d5b678c3b0e1872692f8f9daf33fe306:

Attachment "bug2015723.test" to ticket [2015723fff] added by patthoyts 2008-07-21 20:48:14.

---

# -*- tcl -*-

proc MakeFiles {dirname} {
    set inodes {}
    set ndx -1
    while {1} {
        if {$ndx%100 == 0} {puts -nonewline .;flush stdout}
        set filename [file join $dirname test[incr ndx].txt]
        set f [open $filename w]
        close $f
        file stat $filename stat
        if {[set n [lsearch -exact -integer $inodes $stat(ino)]] != -1} {
            puts ": inode $stat(ino)"
            return [list [file join $dirname test$n.txt] $filename]
        }
        lappend inodes $stat(ino)
        unset stat
    }
}

proc Main {} {
    puts "Tcl [info patchlevel]"
    if {[file isdirectory bug2015723]} {
        file delete -force bug2015723
    }
    file mkdir bug2015723
    foreach {a b} [MakeFiles bug2015723] break
    file rename -force $a $b
    if {[file exists $a]} {
        puts "failed to rename $a to $b"
    } else {
        puts "succeeded"
    }
}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Main] err]
    if {$r} {puts $errorInfo}
    exit $r
}