stafutil.tcl

Software Testing Automation Framework (STAF)的开发代码

            return [lrange $input(object) 1 end]
        }

        setValue {
            # args: objectVar
            set myArgs [list objectVar newValue]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            upvar $input(objectVar) object

            if {[lindex $object 0] == $STAF::NoneType} {
                error "Can't set the value of a None object"
            }

            return [set object "[lindex $object 0] $input(newValue)"]
        }

        default {
            error "Unknown subcommand '$subcommand' specified for STAF::datatype"
        }
    }
}

proc STAF::mapclassdef {args} {
    if {[llength $args] == 0} {
        error {wrong # args: should be "STAF::mapclassdef subcommand ?arg ...?"}
    }

    set subcommand [lindex $args 0]
    set args [lrange $args 1 end]

    switch $subcommand {
        create {
            # args: mapclassname ?definitionObject?
            
            # The definitionObject argument is for internal use only

            set myArgs [list name {mapClassDefObj {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            # ???: We might want to look at handling the mapClassDefObj a
            #      a bit more gracefully.  Like, maybe doing it as an option
            #      instead of an arg.

            if {$input(mapClassDefObj) != ""} {
                return $input(mapClassDefObj)
            }

            set mcd(name) $input(name)
            set mcd(keys) [STAF::datatype createList]

            return [STAF::datatype createMap [array get mcd]]
        }

        createInstance {
            # args: mapclassdef
            set myArgs [list mapclassdef]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            set mapClassName [STAF::mapclassdef getName $input(mapclassdef)]
            set instance($STAF::MAP_CLASS_NAME_KEY) $mapClassName

            return [STAF::datatype createMap [array get instance]]
        }

        addKey {
            # args: mapclassdefVar keyName ?displayName?
            set myArgs [list mapclassdefVar keyName {displayName {}}]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            upvar $input(mapclassdefVar) mcd

            set key(key) $input(keyName)
            set key($STAF::DISPLAY_NAME_KEY) $input(displayName)

            array set mcdArray [STAF::datatype getValue $mcd]
            lappend mcdArray(keys) [STAF::datatype createMap [array get key]]
            STAF::datatype setValue mcd [array get mcdArray]

            return $mcd
        }

        setKeyProperty {
            # args: mapclassdefVar, keyName, property, value):
            set myArgs [list mapclassdefVar keyName property value]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            upvar $input(mapclassdefVar) mcd

            array set mcdArray [STAF::datatype getValue $mcd]
            set outputKeys [STAF::datatype createList]

            foreach key [STAF::datatype getValue $mcdArray(keys)] {
                array set thisKey [STAF::datatype getValue $key]

                if {![string compare $thisKey(key) $input(keyName)]} {
                    set thisKey($input(property)) $input(value)
                }

                lappend outputKeys [STAF::datatype createMap [array get thisKey]]
            }

            set mcdArray(keys) $outputKeys
            STAF::datatype setValue mcd [array get mcdArray]

            return $mcd
        }

        getKeys {
            # args: mapclassdef
            set myArgs [list mapclassdef]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcdArray [STAF::datatype getValue $input(mapclassdef)]

            return $mcdArray(keys)
        }

        getName {
            # args: mapclassdef
            set myArgs [list mapclassdef]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcdArray [STAF::datatype getValue $input(mapclassdef)]

            return $mcdArray(name)
        }

        getMapClassDefinitionObject {
            # args: mapclassdef
            
            # This subcommand is for internal use only
            
            set myArgs [list mapclassdef]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]

            return $input(mapclassdef)
        }

        default {
            error "Unknown subcommand '$subcommand' specified for STAF::mapclassdef"
        }
    }
}


proc STAF::mcontext {args} {
    if {[llength $args] == 0} {
        error {wrong # args: should be "STAF::mcontext subcommand ?arg ...?"}
    }

    set subcommand [lindex $args 0]
    set args [lrange $args 1 end]

    switch $subcommand {
        testOption {
            set myOptions [list opt1 {opt2 def2} opt3]
            set myArgs [list req1 req2 {oarg3 val3} {oarg4 val4}]
            set checkResult \
                [STAF::internalCheckCommandInput $args $myOptions $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }
        }

        create {
            # args: ?rootObject?
            set myArgs [list [list rootObj [STAF::datatype createNone]] [list mapClassMap [STAF::datatype createMap]]]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }
            # array set options [lindex $checkResult 1]
            array set input [lindex $checkResult 2]

            return [STAF::datatype createContext [array get input]]
        }

        setMapClassDefinition {
            set myArgs [list mcVar mapClassDef]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            upvar $input(mcVar) mc
            array set mcArray [STAF::datatype getValue $mc]
            array set mcmArray [STAF::datatype getValue $mcArray(mapClassMap)]

            set mcdName [STAF::mapclassdef getName $input(mapClassDef)]
            set mcmArray($mcdName) $input(mapClassDef)
            STAF::datatype setValue mcArray(mapClassMap) [array get mcmArray]
            STAF::datatype setValue mc [array get mcArray]

            return $mc
        }

        getMapClassDefinition {
            # args: mc mcdName
            set myArgs [list mc mcdName]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcArray [STAF::datatype getValue $input(mc)]
            array set mcmArray [STAF::datatype getValue $mcArray(mapClassMap)]
            set mcdName $input(mcdName)

            if {[info exists mcmArray($mcdName)]} {
                return $mcmArray($mcdName)
            } else {
                return []
            }
        }

        hasMapClassDefinition {
            # args: mc mcdName
            set myArgs [list mc mcdName]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcArray [STAF::datatype getValue $input(mc)]
            array set mcmArray [STAF::datatype getValue $mcArray(mapClassMap)]

            return [info exists mcmArray($input(mcdName))]
        }

        getMapClassMap {
            # args: mc
            set myArgs [list mc]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcArray [STAF::datatype getValue $input(mc)]

            if {[info exists mcArray(mapClassMap)]} {
                return $mcArray(mapClassMap)
            } else {
                return []
            }
        }

        getMapClassDefinitionNames {
            # args: mc
            set myArgs [list mc]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            array set mcArray [STAF::datatype getValue $input(mc)]
            array set mcmArray [STAF::datatype getValue $mcArray(mapClassMap)]

            return [array names mcmArray]
        }

        setRootObject {
            # args: mcVar rootObj
            set myArgs [list mcVar rootObj]
            set checkResult [STAF::internalCheckCommandInput $args {} $myArgs]

            if {[lindex [lindex $checkResult 0] 0] != 0} {
                error [lindex [lindex $checkResult 0] 1]
            }

            array set input [lindex $checkResult 2]
            upvar $input(mcVar) mc
            array set mcArray [STAF::datatype getValue $mc]
            set mcArray(rootObj) $input(rootObj)
            STAF::datatype setValue mc [array get mcArray]