stafutil.tcl

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

            return $mc
        }

        getRootObject {
            # 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)]

            return $mcArray(rootObj)
        }

        getPrimaryObject {
            # 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)]

            if {[array size mcmArray]} {
                return $input(mc)
            } else {
                return $mcArray(rootObj)
            }
        }

        marshall {
            # 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]

            return [STAF::marshall -context $input(mc) $input(mc)]
        }

        formatObject {
            # 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]

            return [STAF::formatObject -context $input(mc) $input(mc)]
        }

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


proc STAF::stringStartsWith {fullString startingString} {
    return [string equal -length [string length $startingString] $fullString $startingString]
}


namespace eval STAF {

    # These variables are for internal use only
    
    variable MARSHALLED_DATA_MARKER  {@SDT/}
    variable NONE_MARKER             {@SDT/$0:0:}
    variable SCALAR_MARKER           {@SDT/$}
    variable SCALAR_STRING_MARKER    {@SDT/$S}
    variable LIST_MARKER             {@SDT/[}
    variable MAP_MARKER              "@SDT/\{"
    variable MC_INSTANCE_MARKER      {@SDT/%}
    variable CONTEXT_MARKER          {@SDT/*}

    variable NONE_STRING             {<None>}
    variable DISPLAY_NAME_KEY        {display-name}
    variable MAP_CLASS_MAP_KEY       {map-class-map}
    variable MAP_CLASS_NAME_KEY      {staf-map-class-name}
    variable ENTRY_SEPARATOR         {}
    # 80 spaces
    variable SPACES                  {                                                                                }
    variable INDENT_DELTA            {2}

}


proc STAF::isMarshalledData {args} {
    # args: data
            
    set myArgs [list data]
    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 data $input(data)

    return [STAF::stringStartsWith $data $STAF::MARSHALLED_DATA_MARKER]
}


proc STAF::marshall {args} {
    # options: -context <context>
    # args: obj
    set myOptions [list {context {}}]
    set myArgs [list obj]
    set checkResult [STAF::internalCheckCommandInput $args $myOptions $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]

    set context $options(context)
    set obj $input(obj)

    if {[STAF::datatype getType $obj] == $STAF::NoneType} {

        return $STAF::NONE_MARKER

    } elseif {[STAF::datatype getType $obj] == $STAF::ListType} {

        set theList [STAF::datatype getValue $obj]
        set theListLength [llength $theList]
        set listData ""

        foreach item $theList {
            append listData [STAF::marshall -context $context $item]
        }

        set listDataLength [string length $listData]

        return "$STAF::LIST_MARKER$theListLength:$listDataLength:$listData"

    } elseif {[STAF::datatype getType $obj] == $STAF::MapType} {

        set mapValue [STAF::datatype getValue $obj]
        array set map $mapValue

        if {$context != "" && \
            [STAF::datatype getType $context] == $STAF::ContextType && \
            [array names map $STAF::MAP_CLASS_NAME_KEY] != "" && \
            [STAF::mcontext hasMapClassDefinition $context \
                            $map($STAF::MAP_CLASS_NAME_KEY)]} {

            set mapClassName $map($STAF::MAP_CLASS_NAME_KEY)
            set mapClass [STAF::mcontext getMapClassDefinition \
                                         $context $mapClassName]
            set mapData ":[string length $mapClassName]:$mapClassName"
            set keyListObj [STAF::mapclassdef getKeys $mapClass]

            foreach keyObj [STAF::datatype getValue $keyListObj] {
                array set key [STAF::datatype getValue $keyObj]
                append mapData [STAF::marshall -context $context \
                                $map($key(key))]
            }

            set mapDataLength [string length $mapData]

            return "$STAF::MC_INSTANCE_MARKER:$mapDataLength:$mapData"

        } else {
            set mapData ""
            array set map [STAF::datatype getValue $obj]

            foreach key [array names map] {
                set keyLength [string length $key]
                append mapData ":" $keyLength ":" $key \
                    [STAF::marshall -context $context $map($key)]
            }

            return "$STAF::MAP_MARKER:[string length $mapData]:$mapData"
        }

    } elseif {[STAF::datatype getType $obj] == $STAF::ContextType} {

        set mapClassMapObj [STAF::mcontext getMapClassMap $obj]
        array set mapClassMap [STAF::datatype getValue $mapClassMapObj]

        if {[array names mapClassMap] == ""} {

            return [STAF::marshall -context $context \
                    [STAF::mcontext getRootObject $obj]]

        } else {

            set contextMap($STAF::MAP_CLASS_MAP_KEY) $mapClassMapObj
            set contextMapObj [STAF::datatype createMap [array get contextMap]]

            set mcData [STAF::marshall -context $context $contextMapObj]
            append mcData [STAF::marshall -context $obj \
                [STAF::mcontext getRootObject $obj]]

            return "$STAF::CONTEXT_MARKER:[string length $mcData]:$mcData"
        }

    } else {

        # Treat this as a scalar

        set scalarValue [STAF::datatype getValue $obj]
        set scalarLength [string length $scalarValue]

        return "$STAF::SCALAR_STRING_MARKER:$scalarLength:$scalarValue"
    }
}


proc STAF::unmarshall {args} {
    # options: -context <context> -ignoreIndirectObjects
    # args: marshalledData
    set myOptions [list [list context [STAF::mcontext create]] ignoreIndirectObjects]
    set myArgs [list md]
    set checkResult [STAF::internalCheckCommandInput $args $myOptions $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]

    set context $options(context)
    set md $input(md)

    set flags ""

    if {[array names options "ignoreIndirectObjects"] != ""} {
        set flags "-ignoreIndirectObjects"
    }

    # Begin unmarshalling

    if {[STAF::stringStartsWith $md $STAF::NONE_MARKER]} {

        return [STAF::mcontext create]

    } elseif {[STAF::stringStartsWith $md $STAF::SCALAR_MARKER]} {

        set colonIndex [string first ":" $md]
        set colonIndex [string first ":" $md [expr $colonIndex + 1]]
        set theString [string range $md [expr $colonIndex + 1] end]

        if {[STAF::stringStartsWith $md $STAF::MARSHALLED_DATA_MARKER] &&
            [array names options "ignoreIndirectObjects"] == ""} {
            return [STAF::unmarshall -context $context $theString]
        }

        return [STAF::mcontext create $theString]

    } elseif {[STAF::stringStartsWith $md $STAF::LIST_MARKER]} {

        set colonIndex [string first ":" $md]
        set numItems [string range $md [string length $STAF::LIST_MARKER] \
            [expr $colonIndex - 1]]
        set dataIndex [expr [string first ":" $md [expr $colonIndex + 1]] + 1]

        set theList [list]

        for {set i 0} {$i < $numItems} {incr i} {
            set colonIndex1 [string first ":" $md $dataIndex]
            set colonIndex2 [string first ":" $md [expr $colonIndex1 + 1]]
            set itemLength [string range $md [expr $colonIndex1 + 1] [expr $colonIndex2 - 1]]

            set dataToUnmarshall [string range $md $dataIndex [expr $colonIndex2 + $itemLength]]
            set outMC [eval {STAF::unmarshall} -context {$context} $flags {$dataToUnmarshall}]

            lappend theList [STAF::mcontext getPrimaryObject $outMC]

            set dataIndex [expr $colonIndex2 + $itemLength + 1]
        }

        return [STAF::mcontext create [STAF::datatype createList $theList]]

    } elseif {[STAF::stringStartsWith $md $STAF::MAP_MARKER]} {

        set colonIndex [string first ":" $md]
        set dataIndex [expr [string first ":" $md [expr $colonIndex + 1]] + 1]
        set dataLength [string length $md]

        while {$dataIndex < $dataLength} {
            set keyColonIndex1 [string first ":" $md $dataIndex]
            set keyColonIndex2 [string first ":" $md [expr $keyColonIndex1 + 1]]
            set keyLength [string range $md [expr $keyColonIndex1 + 1] [expr $keyColonIndex2 - 1]]
            set key [string range $md [expr $keyColonIndex2 + 1] [expr $keyColonIndex2 + $keyLength]]

            set dataIndex [expr $keyColonIndex2 + 1 + $keyLength]
            
            set colonIndex1 [string first ":" $md $dataIndex]
            set colonIndex2 [string first ":" $md [expr $colonIndex1 + 1]]
            set itemLength [string range $md [expr $colonIndex1 + 1] [expr $colonIndex2 - 1]]

            set dataToUnmarshall [string range $md $dataIndex [expr $colonIndex2 + $itemLength]]
            set outMC [eval {STAF::unmarshall} -context {$context} $flags {$dataToUnmarshall}]

            set map($key) [STAF::mcontext getPrimaryObject $outMC]

            set dataIndex [expr $colonIndex2 + $itemLength + 1]
        }

        return [STAF::mcontext create [STAF::datatype createMap [array get map]]]

    } elseif {[STAF::stringStartsWith $md $STAF::MC_INSTANCE_MARKER]} {

        set colonIndex [string first ":" $md]
        set colonIndex2 [string first ":" $md [expr $colonIndex + 1]]

        set colonIndex [string first ":" $md [expr $colonIndex2 + 1]]