Tcl Source Code

Artifact fc9ac233fec7737f9d96116cf64f35c14e65ed3e:

Attachment "utils.tcl" to ticket [fdcc860df5] added by pointsman 2014-11-13 23:21:08. (unpublished)

---

proc readArgs {} {
    global argv
    global options

    foreach {option arg} $argv {
        if {![info exists options($option)]} {
            puts stderr "Unknown option '$option'"
            puts stderr "Known options (and their defaults) are:"
            foreach option [lsort [array names options]] {
                puts stderr "$option ($options($option))"
            }
            exit 1
        }
    }
    foreach {option arg} $argv {
        set options($option) $arg
    }
}

proc getTestFiles {} {
    global options

    set matchFileList [list]
    foreach pattern $options(-file) {
        set tmp [glob -nocomplain -tails \
                     -directory $options(-tcltestdir) $pattern]
        set matchFileList [concat $matchFileList $tmp]
    }
    set matchFileList [lsort -unique $matchFileList]
    set skipFileList [list]
    foreach pattern $options(-notfile) {
        set tmp [glob -nocomplain -tails \
                     -directory $options(-tcltestdir) $pattern]
        set skipFileList [concat $skipFileList $tmp]
    }
    set skipFileList [lsort -unique $skipFileList]
    set matchingFiles [list]
    foreach file $matchFileList {
        if {[lsearch -exact $skipFileList $file] == -1} {
            lappend matchingFiles $file
        }
    }
    if {[llength $matchingFiles] == 0} {
        puts stderr "No test files remain after applying match and\
		skip patterns!"
        exit 1
    }
    return $matchingFiles
}