testtcl.tcl

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

    puts "Expected: $context"
    puts "Found: [STAF::mcontext getPrimaryObject $context]"
    exit 1
}

set context2 [STAF::mcontext create]
STAF::mcontext setRootObject context2 $arrayObject

if {[STAF::mcontext getPrimaryObject $context2] != $arrayObject} {
    puts "Error: Wrong primary object for marshalling context"
    puts "Expected: $arrayObject"
    puts "Found: [STAF::mcontext getPrimaryObject $context2]"
    exit 1
}

# Run mcontext examples in STAF Tcl User's Guide for additional testing,
# including testing the STAF::mcontext marshall subcommand.

# Create a map class definition

set myMapClassDef [STAF::mapclassdef create "Test/MyMap"]
STAF::mapclassdef addKey myMapClassDef "name" "Name"
STAF::mapclassdef addKey myMapClassDef "exec" "Executable"

# Create a marshalling context and set the map class definition
# and assign myTestList as the root object

set mc [STAF::mcontext create]
STAF::mcontext setMapClassDefinition mc $myMapClassDef

# From a list of maps, create a list datatype of map class datatypes
# and marshall that data and assign to a message

set testList [list {exec /tests/TestA.py name TestA} \
                   {exec /tests/TestB.sh name TestB} \
                   {exec /tests/TestC.cmd name TestC}]

set myTestList [STAF::datatype createList]

foreach testObj $testList {
   array set test $testObj
   set testMapObj [STAF::mapclassdef createInstance $myMapClassDef]
   array set testMap [STAF::datatype getValue $testMapObj]
   set testMap(name) $test(name)
   set testMap(exec) $test(exec)
   lappend myTestList [STAF::datatype createMap [array get testMap]]
}

STAF::mcontext setRootObject mc $myTestList

set output1 [STAF::mcontext formatObject $mc]
puts "\nTest List:\n$output1"

# Create a string from the marshalling context
# This string could be a message that you log or send to a queue, etc.

set stringResult [STAF::mcontext marshall $mc]

# Convert the marshalled string representation back into a list

set mc2 [STAF::unmarshall $stringResult]
set theTestList [STAF::mcontext getRootObject $mc2]
puts "\nTest List:\n[STAF::mcontext formatObject $mc2]"

# Create a map class definition passing in the root object
set mc3 [STAF::mcontext create $myTestList]
STAF::mcontext setMapClassDefinition mc3 $myMapClassDef
set output2 [STAF::mcontext formatObject $mc3]
if {[string compare $output1 $output2] != 0} {
    puts "Error: Incorrect formatObject output"
    puts "Expected:\n$output1"
    puts "Found:\n$output2"
    exit 1
}

# Testing STAF::marshall

puts "\nTesting marshall function\n"

puts "Test marshalling a Scalar datatype object"
set myString "This is a test"
puts [STAF::mcontext marshall $myString]

if {[STAF::isMarshalledData $myString]} {
    puts "Error: STAF::isMarshalledData failed"
    puts "Expected: 0"
    puts "Found: [STAF::isMarshalledData $myString]"
    exit 1
}

puts "\nTest marshalling a Context datatype object that doesn't contain any map classes"
set dtList [STAF::datatype createList]
lappend dtList "value 1"
lappend dtList "value 2"
set mc [STAF::datatype createContext]
STAF::mcontext setRootObject mc $dtList
puts [STAF::mcontext marshall $mc]

puts "\nTest marshalling a Map datatype object"
set myTestArray(name) "TestA"
set myTestArray(exec) "/tests/TestA.py"
set myTestArray(testType) "FVT"
set myTestArray(outputs) {"TestA.out" "TestA.err"}
set myTestArrayString [array get myTestArray]
set myArrayObject [STAF::datatype createMap $myTestArrayString]

set message [STAF::marshall $myArrayObject]

if {![STAF::isMarshalledData $message]} {
    puts "Error: STAF::isMarshalledData failed"
    puts "Expected: 1"
    puts "Found: [STAF::isMarshalledData $message]"
    exit 1
}

set request "QUEUE MESSAGE [STAF::WrapData $message]"

if {[STAF::Submit local QUEUE $request] != $STAF::kOk} {
    puts "Error on STAF local QUEUE $request"
    puts "RC=$STAF::RC, Result: $STAF::Result"
    exit $STAF::RC
}

# Another process could obtain the message from the queue and unmarshall
# it to get the original dictionary (map) object

if {[STAF::Submit local QUEUE GET] != $STAF::kOk} {
    puts "Error on STAF local QUEUE GET"
    puts "RC=$STAF::RC, Result: $STAF::Result"
    exit $STAF::RC
}

set mc [STAF::unmarshall $STAF::Result]
set messageMapObj [STAF::mcontext getRootObject $mc]
array set messageMap [STAF::datatype getValue $messageMapObj]
array set yourTestArray [STAF::datatype getValue $messageMap(message)]
puts "Name     : $yourTestArray(name)"
puts "Exec     : $yourTestArray(exec)"
puts "Test Type: $yourTestArray(testType)"
puts "Outputs  : $yourTestArray(outputs)"

if {$myTestArray(name) != $yourTestArray(name)} {
    puts "Error: name mismatch"
    puts "Expected name=$myTestArray(name)"
    puts "Got name=$yourTestArray(name)"
}
if {$myTestArray(exec) != $yourTestArray(exec)} {
    puts "Error: exec mismatch"
    puts "Expected exec=$myTestArray(exec)"
    puts "Got exec=$yourTestArray(exec)"
}
if {$myTestArray(name) != $yourTestArray(name)} {
    puts "Error: testType mismatch"
    puts "Expected testType=$myTestArray(testType)"
    puts "Got testType=$yourTestArray(testType)"
}
if {$myTestArray(outputs) != $yourTestArray(outputs)} {
    puts "Error: outputs mismatch"
    puts "Expected outputs=$myTestArray(outputs)"
    puts "Got outputs=$yourTestArray(outputs)"
}

# Create a map class definition

set myMapClassDef [STAF::mapclassdef create "Test/MyMap"]
STAF::mapclassdef addKey myMapClassDef "name" "Name"
STAF::mapclassdef addKey myMapClassDef "exec" "Executable"

# Create a marshalling context and set the map class definition

set mc [STAF::mcontext create]
STAF::mcontext setMapClassDefinition mc $myMapClassDef

# From a list of maps, create a list datatype of map class datatypes
# and marshall that data and assign to a message

set testList [list {exec /tests/TestA.py name TestA} \
                   {exec /tests/TestB.sh name TestB} \
                   {exec /tests/TestC.cmd name TestC}]

set myTestList [STAF::datatype createList]

foreach testObj $testList {
   array set test $testObj
   set testMapObj [STAF::mapclassdef createInstance $myMapClassDef]
   array set testMap [STAF::datatype getValue $testMapObj]
   set testMap(name) $test(name)
   set testMap(exec) $test(exec)
   lappend myTestList [STAF::datatype createMap [array get testMap]]
}

# Test marshalling a List datatype object
set message [STAF::marshall -context $mc $myTestList]
puts "\nMarshalled Data:\n$message"
set formattedData1 [STAF::formatObject -context $mc $myTestList]
puts "\nFormatted Data:\n$formattedData1"

STAF::mcontext setRootObject mc $myTestList
set formattedData2 [STAF::formatObject $mc]

if {[string compare $formattedData1 $formattedData2] != 0} {
    puts "Error: Incorrect formatObject output testing marshall"
    puts "Expected:\n$formattedData1"
    puts "Found:\n$formattedData2"
    exit 1
}

# Testing STAF::unmarshall

puts "\nTesting unmarshall function\n"

# XXX: Causes error because references a mapclassdef that isn't in the context
# This may be an error in all unmarshall methods.  Need to investigate.
#set myMC [STAF::unmarshall $message]

# Submit a query request to the FS Service to query info about a file

set fileName "{STAF/Config/ConfigFile}"
set request "QUERY ENTRY $fileName"
puts "\nSTAF local FS $request\n"

if {[STAF::Submit local FS $request] != $STAF::kOk} {
    puts "Error on STAF local FS $request"
    puts "RC=$STAF::RC, Result: $STAF::Result"
    exit $STAF::RC
}

set mc [STAF::unmarshall $STAF::Result]
set entryMapObj [STAF::mcontext getRootObject $mc]
array set entryMap [STAF::datatype getValue $entryMapObj]

# Submit a resolve requset to the VAR service to resolve the STAF variable
STAF::Submit local VAR "RESOLVE STRING $fileName"
set resolvedFileName $STAF::Result

if {$entryMap(type) != "F"} {
    puts "$resolvedFileName is not a file.  Type=$entryMap(type)"
} else {
    puts "File Name    : $resolvedFileName"
    puts "File Size    : $entryMap(lowerSize)"
    puts "Last Modified: $entryMap(lastModifiedTimestamp)"
}

# Submit a PROCESS START request and wait for it to complete

set command "dir {STAF/Config/STAFRoot}{STAF/Config/Sep/File}d*"
set request "START SHELL COMMAND [STAF::WrapData $command] RETURNSTDOUT STDERRTOSTDOUT WAIT"
puts "\nSTAF local PROCESS $request"

if {[STAF::Submit local PROCESS $request] != $STAF::kOk} {
    puts "Error on STAF local PROCESS $request"
    puts "Expected RC: 0"
    puts "Received RC: $STAF::RC, Result: $STAF::Result"
    exit $STAF::RC
}

# Unmarshall the result which is a marshalling context whose 
# root object is a map containing keys 'rc', and 'fileList'.
# The value for 'fileList' is a list of the returned files.
# Each entry in the list consists of a map that contains keys
# 'rc' and 'data'.  In our PROCESS START request, we returned
# one file, stdout (and returned stderr to this same file).

set mc [STAF::unmarshall $STAF::Result]
set processMapObj [STAF::mcontext getRootObject $mc]
array set processMap [STAF::datatype getValue $processMapObj]

# Verify that the rc is 0 for returning data for the Stdout file

set fileListObj [STAF::datatype getValue $processMap(fileList)]
set stdoutFileObj [STAF::datatype getValue [lindex $fileListObj 0]]
array set stdoutFileMap [STAF::datatype getValue $stdoutFileObj]

if {$stdoutFileMap(rc) != $STAF::kOk} {
    puts "Error on retrieving process's stdout data."
    puts "Expected RC: 0"
    puts "Received RC: $stdoutFileMap(rc)"
    exit $stdoutFileMap(rc)
}

# Print the data in the stdout file created by the process

puts "\nProcess Stdout file contains:\n$stdoutFileMap(data)"

# Verify that the process rc is 0

if {$processMap(rc) != $STAF::kOk} {
    puts "Process RC: $processMap(rc)"
    exit $processMap(rc)
}

#foreach fileObj [STAF::datatype getValue $processMap(fileList)] {
#    array set fileMap [STAF::datatype getValue $fileObj]
#    if {$fileMap(rc) == 0} {
#        puts "File data:\n$fileMap(data)"
#    } else {
#        puts "Error getting file, RC: $fileMap(rc)"
#    }
#}

######################################
# Now, let's test STAF::formatObject #
######################################

puts "Testing formatObject"

puts "\nTest printing a None datatype\n"
set dtNone [STAF::datatype createNone]
puts "STAF::formatObject \$dtNone:"
puts [STAF::formatObject $dtNone]

puts "\nTest printing a Scalar datatype\n"
set testString "This is a test"
puts "STAF::formatObject \$testString:"
puts [STAF::formatObject $testString]

puts "\nTest printing a List datatype containing only scalars\n"
set listValue [list "Item #1" "Item #2" "Item #3"]
lappend listValue $dtNone
set dtList [STAF::datatype createList $listValue]
puts "STAF::formatObject \$dtList:"
set listOutput1 [STAF::formatObject $dtList]
puts [STAF::formatObject $listOutput1]

puts "\nTest printing a List datatype using the -context option\n"
puts "STAF::formatObject -context [STAF::mcontext create \$dtList] \$dtList:"
set listOutput2 [STAF::formatObject -context [STAF::mcontext create $dtList] $dtList]
if {[string compare $listOutput1 $listOutput2]} {
    puts "Error: Incorrect formatObject output printing a List datatype"
    puts "Expected:\n$listOutput1"
    puts "Found:\n$listOutput2"
    exit 1
}

puts "\nTest printing a List datatype using the -context and -indentLevel options\n"
puts "STAF::formatObject -context [STAF::mcontext create \$dtList] -indentLevel 0 \$dtList:"
set listOutput2 [STAF::formatObject -context [STAF::mcontext create $dtList] -indentLevel 0 $dtList]
if {[string compare $listOutput1 $listOutput2]} {
    puts "Error: Incorrect formatObject output printing a List datatype"
    puts "Expected:\n$listOutput1"
    puts "Found:\n$listOutput2"
    exit 1
}

puts "\nTest printing a List datatype containing another list datatype\n"
set listValue [list "Item #4a" "Item #4b"]
lappend dtList [STAF::datatype createList $listValue]
#set dtList [STAF::datatype createList $listValue]
puts "STAF::formatObject \$dtList:"
puts [STAF::formatObject $dtList]

puts "\nTest printing a Map datatype containing only Scalar/None values\n"
set mapInit(key1) value1
set mapInit(key2) value2
set mapInit(key3) $dtNone
set mapInitValue [array get mapInit]
set dtMap [STAF::datatype createMap $mapInitValue]
puts "STAF::formatObject \$dtMap:"
puts [STAF::formatObject $dtMap]

puts "\nTest printing a Map datatype containing Scalar and List objects\n"
set myTestMap(name) TestA
set myTestMap(exec) "/tests/TestA.tcl"
set myTestMap(testType) FVT
set listValue [list TestA.out TestA.err]
set dtList [STAF::datatype createList $listValue]
set myTestMap(outputs) $dtList
set dtTestMap [STAF::datatype createMap [array get myTestMap]]
puts "STAF::formatObject \$dtTestMap:"
puts [STAF::formatObject $dtTestMap]

puts "\nTest printing the process Map datatype object without a context\n"
puts "STAF::formatObject \$processMapObj:"
puts [STAF::formatObject $processMapObj]

puts "\nTest printing the process Map datatype object with a context\n"
puts "STAF::formatObject -context \$mc \$processMapObj:"
set processOutput1 [STAF::formatObject -context $mc $processMapObj]
puts $processOutput1

puts "\nTest printing the result from a PROCESS START WAIT request"
puts "STAF::formatObject \$mc:"
set processOutput2 [STAF::formatObject $mc]
if {[string compare $processOutput1 $processOutput2]} {
    puts "Error: Incorrect formatObject output printing the PROCESS START result"
    puts "Expected:\n$processOutput1"
    puts "Found:\n$processOutput2"
    exit 1
}

puts "\nTest printing a Map datatype which is the output from a FS QUERY ENTRY request\n"
set fileName "{STAF/Config/ConfigFile}"
set request "QUERY ENTRY $fileName"
puts "STAF local FS $request\n"

if {[STAF::Submit local FS $request] != $STAF::kOk} {
    puts "Error on STAF local FS $request"
    puts "RC=$STAF::RC, Result: $STAF::Result"
    exit $STAF::RC
}

set mc [STAF::unmarshall $STAF::Result]
puts "Formatted output:\n[STAF::formatObject $mc]"


puts "\n**************************************************************"
puts "Test Performance for Marshalling, FormatObject, and Unmarshall"
puts "**************************************************************"

# Test using a list with the specified number of entries

set entries 2500

puts "\nTest using a list with $entries entries"

set dtList [STAF::datatype createList]
set i 0 

while {$i < $entries} {
    lappend dtList "entryValue ##$i" 
    incr i +1
} 

set mc [STAF::datatype createContext]
STAF::mcontext setRootObject mc $dtList

puts "FormatObject started : [clock format [clock seconds]]"
STAF::formatObject $mc
puts "FormatObject ended   : [clock format [clock seconds]]"

puts "Marshalling started  : [clock format [clock seconds]]"
set result [STAF::mcontext marshall $mc] 
puts "Marshalling ended    : [clock format [clock seconds]]"

puts "Length of marshalled data: [string length $result]"

puts "Unmarshalling started: [clock format [clock seconds]]"
set mc [STAF::unmarshall $result]
puts "Unmarshalling ended  : [clock format [clock seconds]]"


#############
# Finish up #
#############

if {[STAF::UnRegister] != 0} {
    puts "Error unregistering with STAF, RC: $STAF::RC"
    exit $STAF::RC
}

puts "All tests successful"

exit 0