Tcl Source Code

Artifact 3845d2558f5b57658c2f691e619d8d2134de135e:

Attachment "test_bug.tcl" to ticket [2834453fff] added by exgerhardr 2009-08-09 19:57:55.

---

#!/bin/sh
#
# let's start the TCL-shell\
exec tclsh "$0" "{1+$@}"

###################################################
### adjust to your requirements - BEGIN
###
if {$tcl_platform(platform) eq "windows"} {
  set dir {Y:\WinXP\test}
} else {
  set dir "/net/pub/WinXP/test"
}
###
### adjust to your requirements - END
###################################################
set i -1
puts "tcl version=[info patchlevel]"
puts "*** File name list of dir $dir"
foreach f [lsort [glob [file join $dir *]]] {
  puts "[incr i]: [file tail [file normalize $f]]"
}
puts "*** Bug test cases"

set actd [pwd]
foreach which {0 1 2 3} {

  cd $actd
  set norm [expr {$which%2}]
  switch $which {
    0 { 
      set pattern [file join $dir *]
      set tpath full 
      set normp no
    }
    1 { 
      set pattern [file join $dir *]
      set tpath full 
      set normp yes
    }
    2 { 
      set pattern *
      set tpath relative 
      set normp no
      cd $dir
    }
    3 { 
      set pattern *
      set tpath relative 
      set normp yes
      cd $dir
    }
  }

  set i -1
  foreach f [lsort [glob $pattern]] {
    puts "=== [incr i]: normalize=$normp, path=$tpath File: $f ==="
    
    if {$normp} {
      set res [catch {set f [file normalize $f]} err] 
      if {$res} {
        puts "Error: \[file normalize\] failed: $err"
        continue
      }
    }  

    puts -nonewline     {[file exist $f]-> }
    set res [catch {puts [file exist $f]} err]
    if {$res} {puts $err}

    puts -nonewline     {[file type $f]-> }
    set res [catch {puts [file type $f]} err]
    if {$res} {puts $err}

    puts -nonewline     {[file type [subst -novariables $f]]-> }
    set res [catch {puts [file type [subst -novariables $f]]} err]
    if {$res} {puts $err}

    puts -nonewline     {[file type [subst -nocommands $f]]-> }
    set res [catch {puts [file type [subst -nocommands $f]]} err]
    if {$res} {puts $err}

    puts -nonewline     {[file type [subst -nobackslashes $f]]-> }
    set res [catch {puts [file type [subst -nobackslashes $f]]} err]
    if {$res} {puts $err}
  }

  puts ""

}