# BEGIN_ICS_COPYRIGHT8 ****************************************
# 
# Copyright (c) 2015, Intel Corporation
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
# 
#     * Redistributions of source code must retain the above copyright notice,
#       this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * Neither the name of Intel Corporation nor the names of its contributors
#       may be used to endorse or promote products derived from this software
#       without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# END_ICS_COPYRIGHT8   ****************************************

# [ICS VERSION STRING: unknown]

## The tools.exp expect script file contains various utility routines which can
## be used in the generation of test scripts
## It is auto sourced into expect

## Future enhancement - provide a spawn_id argument to the expect_ procedures?
## Current handling assumes a single spawned process or the manipulation of
## spawn_id prior to calling them.
##

## User Controlled Global variables:
## ---------------------------------
## These variables are available to the user for read/write access
## They are used (read only) internally by the tools procedures.
##
## env(TEST_STOP_FAILED)
##	none - do not stop on any failure
##	suite - abort test suite only on the failure of a test suite
##	case - abort test suite on the failure of any test case
##	any - abort test suite on the failure of any test item
##	default is none
## env(TEST_SAVE_FAILED)
##	no - do not save any temporary files in the case of a failure
##	yes - save all temporary files in the case of a failure
##	default is yes
## env(TEST_SAVE_TEMP)
##	no - do not save any temporary files between test cases
##	yes - save all temporary files for each test case
##	default is no
## env(TEST_SAVE_FIRST)
##	when saving temp files for TEST_SAVE_FAILED or TEST_SAVE_TEMP should
##	an existing save_tmp be retained in preference to the newer files
##	yes - keep existing files, reflecting 1st run or failure of test
##	no - replace existing files, reflecting last run or failure of test
##	default yes
## env(TEST_PARALLEL)
##	no - serialize all tests
##	yes - when supported by a test_suite, parallelize test cases
##	default is yes
## env(TEST_MAX_PARALLEL)
##	maximum processes to concurrently execute in parallel blocks
##	default is 20
## env(TEST_TIMEOUT_MULT)
##	multiplier for all timeouts during a test (used to account for slower hosts)
##	default is 1
## env(TEST_SHOW_CONFIG)
##	show configuration at start of test suite
##	default is yes
## env(TEST_SHOW_START)
##	output a message at start of each test case
##	default is no
## env(TEST_RESULT_DIR)
##	directory to put test.log, test.res, identify.log, save_tmp, and test_tmp
##	default is .
## env(CFG_*)
##	assorted test target/driver configuration information from config file
## env(TEST_SUITES)
## env(TEST_SKIP_SUITES)
##	A space separated list of test suite tags for test suites to run/not run.
##	If not exported all the test suites are run
##	For example:
##		export TEST_SUITES="suite1 suite2"
##	will cause only tests within suite1 and suite2 to be executed. All
##	other test suites will be completely skipped including their
##	initialization and cleanup code.
##	The test cases run within the selected test suites can be further
##	limited by using the TEST_CASES variable (see below).
##	Shell style "glob" patterns can be used
##	If a test suite matches both TEST_SUITES and TEST_SKIP_SUITES it is skipped
## env(TEST_CASES)
## env(TEST_SKIP_CASES)
##	A space separated list of tags for the test cases to run/not run.  The tags
##	can be either the tag for a test case or a test_suite_tag.test_case_tag.
##	If not exported all the test cases in the selected test suites are
##	run.
##	For example:
##		export TEST_CASES="tag1 tag2"
##	will cause test cases tag1 and tag2 to be executed within all the
##	selected test suites.
##		export TEST_CASES="suite1.tag1 suite2.tag2"
##	Will cause test case tag1 within suite1 to be executed and tag2
##	within suite2 to be executed.  Note that this will not prevent the
##	execution of initialization and cleanup code from any other test suites 
##	hence it is usually desirable when multiple test suites are potentially
##	being run, to limit the test suites by using the TEST_SUITES variable
##	(see above).  So in the case above:
##		export TEST_SUITES="suite1 suite2"
##		export TEST_CASES="suite1.tag1 suite2.tag2"
##	will make sure that any test suites other than suite1 or suite2
##	are totally skipped.
##	Shell style "glob" patterns can be used
##	If a test case matches both TEST_CASES and TEST_SKIP_CASES it is skipped
## env(TEST_ITEMS)
## env(TEST_SKIP_ITEMS)
##	A space separated list of tags for the test items to run/not run.  The tags
##	can be either the tag for a test item or a
##	test_suite_tag.test_case_tag.test_item_tag.
##	If not exported all the test items in the selected test
##	cases in the selected test suites are run.
##	For example:
##		export TEST_ITEMS="tag1 tag2"
##	will cause test items tag1 and tag2 to be executed within all the
##	selected test cases.
##		export TEST_ITEMS="suite1.tag1.item1 suite2.tag2.item2"
##	Will cause test item item1 within test case tag1 within suite1 to be
##	executed and item2 in test case tag2 within suite2 to be executed.
##	Note that this will not prevent the execution of initialization and
##	cleanup code from any other test suites hence it is usually desirable
##	when multiple test suites are potentially being run, to limit the test
##	cases and suites by using the TEST_SUITES and TEST_CASES variables
##	(see above).  So in the case above:
##		export TEST_SUITES="suite1 suite2"
##		export TEST_CASES="suite1.tag1 suite2.tag2"
##		export TEST_ITEMS="suite1.tag1.item1 suite2.tag2.item2"
##	will make sure that any test suites other than suite1 or suite2
##	and any cases other than suite1.tag1 and suite2.tag2
##	are totally skipped.
##	Shell style "glob" patterns can be used
##	If a test item matches both TEST_ITEMS and TEST_SKIP_ITEMS it is skipped
## env(TEST_NOEXECUTE)
##	list of test operations/initializations to skip execution of
##	the valid set of entries is defined by the test suite itself.
##	This can be used to selectively disable test_execute operations
##	within the test suite, typically within the initialization routines.
## env(TEST_IDENTIFY)
##	disable test execution, simply identify the tests within the suite
##	this is not completely implemented yet.
## env(TEST_DEBUG_LEVEL)
##	Enable additional test debug output to the log
##
## Additional global variables (read only in this file,
##	 but internally set by test scripts):
## spawn_id - expect's spawn id, made global for ease of use
## spawn_out - expect's spawn output information, made global for ease of use
## interact_out - expect's interact output, made global for ease of use
## expect_out - expect's expect output, made global for ease of use
## timeout - expect's timeout value, made global for ease of use
## lines_to_show - number of lines to show from stdout of a child
##	when it exits.  Default is 10.
## expecting - current message or item being expected.  This is output in
##	the timeout handler for expect_after to aid debug of failed tests.
##	defaults to "" at start of each test case/suite.
## features(au,feature) - feature status for each AU
##
## Files Generated:
## ----------------
## Any test suite which uses these tools and the associated test automation
## makefiles (to run the tests) will automatically generate
## various files as follows:
##	test.res - summary of tests run and brief results
##	test.log - detailed summary of test
##	save_tmp/test_suite_tag/test_case_tag/*
##		- log and data files from running the given test suite and
##			test case, the test_suite_tag component will be
##			the actual test suite tag as specified in the
##			test_suite procedure call, similar for test_case_tag
##			The selection as to which cases generate such files
##			depends on the env(TEST_SAVE_FAILED) and
##			env(TEST_SAVE_TEMP) variables.  The default is to
##			only save results for failed test cases, but this can
##			be altered by the user through these variables.
##			The special test_case_tags of "suite_setup" and
##			suite_cleanup are used to save log files from the
##			suite_setup and suite_cleanup routines
##	test_tmp$$ - temporary files, renamed as save_tmp/... or removed
##			when test completes
##	identify.res - summary of test suites automated within the directory
##			This is generated when env(TEST_IDENTIFY)=yes
##			as opposed to actually running the test suites
## File Formats:
## -------------
## Some of these files can be machine parsed or easily greped for various
## patterns.  In the messages below, fields bracketed in '' are replaced with
## variables from execution time.  Hence ['DATE'] in a message may be
## emitted as [10:05:39 Jul 20, 1996]
##
##   test.res
##   --------
##	The test.res file contains the following types of messages:
##	Executing 'NAME' Test Suite ('TAG') ['DATE'] ...
##		- the given test suite is being started
##	Executing 'NAME' Test Suite ('TAG') ['DATE'] ...
##	SKIPPED
##		- the given test suite is being skipped
##	Test Configuration File: 'FILENAME'
##		- the given configuration file will guide the test suite
##		of course the environment may override config file values
##	FAILURE during test suite: 'MULTI_LINE_DESCRIPTION'
##		- the given error occured during the test suite and caused
##		it to prematurely abort.  No further messages will be provided
##		for the suite other than a multi-line description of the error
##	TEST SUITE FAILURE: 'MULTI_LINE_DESCRIPTION'
##	TEST SUITE 'NAME' TESTS ABORTED
##		- fatal test suite error
##	TEST SUITE 'NAME': 'CNT' Cases; 'CNT' PASSED; 'CNT' FAILED; 'CNT' SKIPPED
##	TEST SUITE 'NAME': 'CNT' Cases; 'CNT' PASSED; 'CNT' FAILED
##	TEST SUITE 'NAME': 'CNT' Cases; 'CNT' PASSED; 'CNT' SKIPPED
##	TEST SUITE 'NAME': 'CNT' Cases; 'CNT' PASSED
##		- cummulative results for test suite
##		- cummulative results for test suite
##	TEST SUITE 'NAME' PASSED
##	TEST SUITE 'NAME' FAILED
##		- overall results of suite (only passes if all cases passed
##		excluding those skipped)
##	Done 'NAME' Test Suite ['DATE']
##		- test suite completed
##	TEST SUITE 'NAME' CASE ('FULL_TAG') 'CASE_NAME': PASSED
##	TEST SUITE 'NAME' CASE ('FULL_TAG') 'CASE_NAME': FAILED
##	TEST SUITE 'NAME' CASE ('FULL_TAG') 'CASE_NAME': SKIPPED
##		- test case results, Note in some cases the PASSED/FAILED
##		may not appear on the same line as the TEST CASE name.
##		This can be due to configuration errors causing setup errors
##		or because the test case includes test items.  For the 
##		passing case, an additional line will be logged.
##	TEST CASE FAILURE='MULTI_LINE_ERROR'
##		test case failed for given reason
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' PASSED; 'CNT' FAILED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' PASSED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' FAILED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' PASSED; 'CNT' FAILED; 'CNT' SKIPPED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' PASSED; 'CNT' SKIPPED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' FAILED; 'CNT' SKIPPED
##	TEST CASE 'NAME': 'CNT' Items; 'CNT' STARTED; 'CNT' SKIPPED
##		- cummulative results for test case which had test_items
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME': PASSED
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME' PASSED
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME': FAILED
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME' FAILED
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME': SKIPPED
##	TEST SUITE 'NAME' ITEM ('FULL_TAG') 'ITEM_NAME': STARTED
##		- test case item results, Note in some cases the PASSED/FAILED
##		may not appear on the same line as the TEST CASE name.
##		This can be due to configuration errors causing setup errors
##		or because the test case includes test items.
##		For the STARTED case, a subsequent PASSED or FAILED line will
##		also be logged.
##	PERF performance data
##		Performance data reported by test which should be part of performance
##		section of final report
##	additional messages could appear in the log

##
##   identify.res
##   ------------
##
##  ***************************
##	Directory: 'DIRECTORY_NAME'
##		- the given subdirectory exists which contains additional
##		test suites (and an identify.res file)
##		the details of those test suites follows this marker
##	==============
##		- preceeds data for a new test suite
##	Test Suite: 'NAME' ('TAG')
##	'MULTI_LINE_INFORMATION'
##		- test suite name, tag and detailed (multi-line) description
##
##		configuration variable settings from configuration file
##		any messages from test suite setup routines, possibly
##		failures
##	--------------
##		- preceeds data for a new test case
##	Test Case: 'NAME' ('FULL_TAG')
##	'MULTI_LINE_INFORMATION'
##		- test suite and test case name, tag and detailed
##			(multi-line) description.  Description is for the test
##			case only, description from test suite (above) may
##			provide additional information
##
##
## Internal Global variables:
## --------------------------
## These variables are used internally by the tools procedures.
## they may be read by the user, but not modified.
##
## tools_suite_name - name of current test suite (user should not change)
## tools_suite_tag - tag of current test suite (user should not change)
## tools_suite_result - PASSED/FAILED overall result for test suite
## tools_suite_status - status of most recent (current if still in progess)
##		test_suite: "okay" if normal, "skip" if test cases should be
##		skipped, "fail" if failed, and "abort" if the suite was programmatically aborted.
## tools_suite_count - on going count of the number of test suites run
## tools_case_name - name of current test case (user should not change)
## tools_case_tag - tag of current test case (user should not change)
## tools_case_count - on going count of the number of test cases run
## tools_case_passed - on going count of the number of test cases that passed
## tools_case_failed - on going count of the number of test cases that failed
## tools_case_skipped - on going count of the number of test cases skipped
## tools_case_async - flag if test case involves asynchronous test items
## tools_case_status - status of most recent (current if still in progess)
##		test_case: "okay" if normal, "skip" if test items should be
##		skipped, "fail" if failed, and "abort" if the case was programmatically aborted.
## tools_item_name - name of current test case (user should not change)
## tools_item_tag - tag of current test case (user should not change)
## tools_item_count - on going count of the number of test items run
## tools_item_passed - on going count of the number of test items that passed
## tools_item_started - on going count of the number of test items that started
## tools_item_failed - on going count of the number of test items that failed
## tools_item_skipped - on going count of the number of test items skipped
## tools_item_*_list - lists of test item information for async test cases
## test_tmp - directory for temporary files, renamed as save_tmp/... or removed
##			when test completes
##
## Tcl Library Paths
## -----------------
##	When test_expect is run, the Tcl library search path automatically
##	is appended to to include $BUILD_DIR/tcl_libs, $RELEASE_DIR/tcl_libs
##	and the current working directory.  As needed you can create libraries
##	of routines for use by you various test suites and build the
##	corresponding tclIndex to allow those libraries to be run without
##	needing to explicity source the files.

# defaults
set default_TEST_STOP_FAILED none
set default_TEST_SAVE_FAILED yes
set default_TEST_SAVE_TEMP no
set default_TEST_SAVE_FIRST yes
set default_TEST_PARALLEL yes
set default_TEST_MAX_PARALLEL 20
set default_TEST_TIMEOUT_MULT 1
set default_TEST_IDENTIFY no
set default_TEST_SHOW_CONFIG yes
set default_TEST_SHOW_START no
set default_TEST_RESULT_DIR "."
set default_TEST_SERIALIZE_OUTPUT no

set tools_suite_count 0
set tools_suite_failed 0
set log_disable 0

# if we redirect stdout as part of serializing parallel output, we save
# the original stdout here so we can still output some interactive messages
set orig_stdout ""

proc test_suite { tag name information startup cleanup code } {
##
## test_suite
## -----------
## utility procedure to execute a test suite
##
## Usage:
##	test_suite tag name information startup cleanup {
##		code for test suite (typically calls to test_case)
##	}
## Arguments:
##	tag - short tag for test suite, no spaces or special characters allowed
##		used to name directory to save results
##	name - name of test suite
##	information - brief description of test suite
##	startup - procedure to execute at start of the test suite
##	cleanup - procedure to execute at the end of the test suite
##	code = Tcl commands for test suite (typically a list with 1 or
##		more invocations of test_case)
## Returns:
##	none
## Additional Information:
##	Any test_case calls must be made within the code of this
##	control structure
##

	global tools_suite_name
	global tools_suite_tag
	global tools_suite_result
	global tools_suite_status
	global tools_suite_count
	global tools_case_count
	global tools_case_passed
	global tools_case_failed
	global tools_case_skipped
	global env
	global spawn_id
	global spawn_out
	global interact_out
	global expect_out
	global timeout
	global expecting
	global features

	set tools_suite_name $name
	set tools_suite_tag $tag

	if { ! [ identify_mode ] } {
		# create test_tmp for use by startup code
		make_test_tmp
		log_redirect
		log_message "Start $name Test Suite ($tag) [date_stamp]"
		log_message "=============================================================================="
		puts "Executing $name Test Suite ($tag) [date_stamp] ..."

		log_message "$information\n"
		log_message "[date_stamp]"
		log_message ""
	}

	set tools_suite_result "PASSED"
	set tools_suite_status "okay"

	clear_case_counters

	incr tools_suite_count

	set spawn_id "";	# create variable
	set expecting "";	# create variable
	set_timeout 60;		# create and initialize variable

	# test for test_suite_tag in TEST_SUITES/TEST_SKIP_SUITES
	if { [ check_skip_test TEST_SUITES TEST_SKIP_SUITES "{$tag}" ] } {
		show_message "SKIPPED"
		log_message ""
		remove_test_tmp
		return
	}

	if { [ info exists env(TEST_CONFIG_FILE) ] != 1 } {
		remove_test_tmp
		fail_suite "FAILURE during test suite: Environment variable TEST_CONFIG_FILE not set" 1
	}
	if { [ catch { read_config $env(TEST_CONFIG_FILE) } res ] != 0 } {
		remove_test_tmp
		fail_suite "FAILURE during test suite: failed to read $env(TEST_CONFIG_FILE) $res" 1
	}

	# test for test_suite_tag in TEST_SUITES/TEST_SKIP_SUITES
	if { [ check_skip_test TEST_SUITES TEST_SKIP_SUITES "{$tag}" ] } {
		show_message "TEST SUITE $tools_suite_name ($tag) TESTS SKIPPED"
		log_message ""
		remove_test_tmp
		return
	}

	# only identify suites which are not skipped
	if { [ identify_mode ] } {
		log_file -a [test_get_env TEST_RESULT_DIR]/identify.log
		puts "=============================================================================="
		puts "Test Suite: $name ($tag)"
		puts "$information\n"
	}

	test_execute {} {
		setup_expect_after
	}
	set res [ catch {
		set expecting ""
		set_timeout 60
		if { [ catch { eval $startup } err_str2 ] != 0 } {
			cleanup_all_children
			test_execute {} {
				log_restore
				save_test_tmp $tools_suite_tag suite_setup TEST_SAVE_FAILED
			}
			error "suite_setup failed: $err_str2"
                } elseif { "$err_str2" == -1} {
                        # skip test_suite and do not run cleanup proc
                        show_message "TEST SUITE $tools_suite_name ($tag) TESTS SKIPPED"
                        set tools_suite_status "skipped"
                        log_message ""
                        set cleanup "noop"
                        set tools_suite_result "SKIPPED"
                        test_execute {} {
                            log_restore
                            save_test_tmp $tools_suite_tag suite_setup TEST_SAVE_TEMP
			}
                        remove_test_tmp
                } else {
			test_execute {} {
				log_restore
				save_test_tmp $tools_suite_tag suite_setup TEST_SAVE_TEMP
			}

                        set expecting ""
                        set_timeout 60
                        # code is run even in identify mode so that test cases
	    	        # can identify themselves
                        eval $code
                }
	} err_str ] 
	if { $res != 0 } {
		if { $tools_suite_status == "okay" } {
			fail_suite "FAILURE during test suite: $err_str" 0
		}
	}

	set expecting ""
	set_timeout 60
	if { "$cleanup" != "" && "$cleanup" != "noop" } {
		test_execute {} {
			make_test_tmp
			log_redirect
		}
		if { [ catch { eval $cleanup [expr { "$tools_suite_result" == "FAILED" }] } err_str2 ] != 0 } {
			cleanup_all_children
			test_execute {} {
				log_restore
				save_test_tmp $tools_suite_tag suite_cleanup TEST_SAVE_FAILED
			}
			if { $tools_suite_status == "okay" } {
				fail_suite "FAILURE during test suite $cleanup function: $err_str2" 0
			}
		} else {
			test_execute {} {
				log_restore
				save_test_tmp $tools_suite_tag suite_cleanup TEST_SAVE_TEMP
			}
		}
	}
	cleanup_all_children
	set message "TEST SUITE $tools_suite_name: $tools_case_count Cases; $tools_case_passed PASSED"
	if { $tools_case_failed != 0 } {
		append message "; $tools_case_failed FAILED"
	}
	if { $tools_case_skipped != 0 } {
		append message "; $tools_case_skipped SKIPPED"
	}
	show_message "$message"
	show_message "TEST SUITE $tools_suite_name $tools_suite_result"
	show_message "Done $tools_suite_name Test Suite [date_stamp]\n"
	if { [ identify_mode ] } {
		puts ""
	}
	remove_test_tmp
	clear_case_counters

	return
}

proc log_redirect {} {
	global test_tmp

	# redirect the log for a test case
	log_file
	log_file -a $test_tmp/test.log
}

proc log_restore {} {
	# restore the logging and append the test case's log to the
	# main log
	global test_tmp
	set test_log "[test_get_env TEST_RESULT_DIR]/test.log"

	log_file
	# RHEL5, SLES10 and newer distros have flock which can correct a race here
	# on older distros we could use tclX's flock command, but not worth the
	# trouble to fix for RHEL4 at this time
	if { [catch { exec which flock > /dev/null 2>/dev/null } ] == 0 } {
		exec flock $test_log tee -a $test_log < $test_tmp/test.log > /dev/null
	} else {
		exec cat $test_tmp/test.log >> $test_log
	}
	log_file -a $test_log
}

set punchlist_fd ""
set start_time ""

proc open_punchlist { fname } {
	global start_time punchlist_fd

	if { "$start_time" == "" } {
		set start_time [ timestamp -format "%Y/%m/%d %H:%M:%S" ]
	}
	if { "$punchlist_fd" == "" } {
		set punchlist_fd [open "$fname" {WRONLY APPEND CREAT} ]
		fconfigure $punchlist_fd -buffering line
	}
}

proc close_punchlist {} {
	global start_time punchlist_fd

	if { "$punchlist_fd" != "" } {
		close $punchlist_fd
		set punchlist_fd ""
	}
}

# open, append and close punchlist
# any errors are logged but will not cause exceptions
proc append_punchlist { device issue } {
	global start_time punchlist_fd

	set fname "[test_get_env TEST_RESULT_DIR]/punchlist.csv"
	if { [ catch { open_punchlist "$fname" } err_str ] != 0 } {
		log_message "\nERROR: Unable to open punchlist: $fname: $err_str"
	} else {
		if { [ catch { puts $punchlist_fd "$start_time;$device;$issue" } err_str ] != 0 } {
			log_message "\nERROR: Unable to write punchlist: $fname: $err_str"
		}
	}
	catch { close_punchlist }
}

proc setup_expect_after {} {
	global spawn_id

	# set up so all subsequent expects fail on unexpected conditions
	# Note that since expect_after is used, eof or timeout within
	# specific
	# test invocations (such as expect_eof) will be evaluated before
	# those here
	# spawn_id is global and indirect so that as a process is
	# spawned, the expect_after will apply to it automatically
	expect_after {
        	-i spawn_id eof		{ 
					global expecting
					if { "$expecting" != "" } {
						log_message "\nERROR: EOF waiting for: $expecting"
					}
					ignore_rest
					fail_test "eof"
					}
			-i spawn_id timeout	{ 
					global spawn_id expecting

					if { "$expecting" != "" } {
						log_message "\nERROR: timeout ($timeout) waiting for: $expecting"
					}
					# get buffered data
					expect *
					if { "$expect_out(buffer)" != "" } {
						log_message "\nERROR: Received data: $expect_out(buffer)"
						fail_test "timeout: with data"
					} else {
						fail_test "timeout: No data"
					}
				}
	}
}

proc disable_expect_after {} {
	expect_after
}

proc test_case { tag name information startup cleanup code { failure_code "" }} {
##
## test_case
## ---------
## This executes the given test case
##
## Usage:
##	test_case tag "test name" "test description" startup cleanup {
##		code for test
##	}
## Arguments:
##	tag - short tag for test case, no spaces or special characters allowed
##		used to name directory to save results
##	name = test case name
##	information = brief description of test
##	code = Tcl commands for test case (typically a list)
##	startup - procedure to execute at start of the test case
##	cleanup - procedure to execute at the end of the test case
## Returns:
##	0 - test success or explicitly skipped or identify mode
##	1 - test failure or skipped due to earlier fail_suite
## Additional Information:
##	In general the code should avoid doing output such that the
##	output will simply include test cases and PASS/FAIL status
##	Any error returns within $code will indicate a test failure.
##	In general, fail_test should be invoked to indicate such failures.
##	Any detailed logging of test progress should be done using log_message
##
##	This routine always removes/mkdir's test_tmp at the start of each
##	test case and removes it at the end of each test case.
##
##	The failure_code is run before saving test_tmp (if TEST_SAVE_FAILED exported)
##	and prior to running any cleanup code (defined for test_suite)
##	Its typical use to to extract additional information into test_tmp
##	to aid the debug of why the test case failed
##	The log during the test case is kept in test_tmp/test.log (and
##	saved based on TEST_SAVE_FAILED) and at the end of the test case it is
##	appended to the main test.log

	global tools_suite_name
	global tools_suite_tag
	global tools_suite_result
	global tools_suite_count
	global tools_suite_status
	global tools_case_name
	global tools_case_tag
	global tools_case_count
	global tools_case_passed
	global tools_case_failed
	global tools_case_skipped
	global tools_case_status
	global tools_item_name
	global tools_item_tag
	global tools_item_count
	global tools_item_passed
	global tools_item_started
	global tools_item_failed
	global tools_item_skipped
	global tools_item_status
	global tools_case_async
	global tools_item_tag_list
	global tools_item_full_tag_list
	global tools_item_name_list
	global tools_item_status_list
	global orig_stdout

	global env
	# force spawn_id returned by any spawn's within $code to be global
	global spawn_id
	global spawn_out
	global interact_out
	global expect_out
	global timeout
	global expecting
	global features

	set tools_case_status "okay"
	incr tools_case_count

	clear_item_counters
	set tools_case_async 0
	set tools_item_tag_list {}
	set tools_item_full_tag_list {}
	set tools_item_name_list {}
	set tools_item_status_list {}

	set full_tag "$tools_suite_tag\.$tag"
	set tools_case_name "$name"
	set tools_case_tag "$full_tag"

	if { ! [ identify_mode ] } {
		make_test_tmp

		log_redirect
		if { [ show_start ] } {
			if { $orig_stdout != "" } {
				puts $orig_stdout "Executing TEST SUITE $tools_suite_name CASE ($full_tag) $name ... "
			} else {
				puts "Executing TEST SUITE $tools_suite_name CASE ($full_tag) $name ... "
			}
		}
		puts -nonewline "TEST SUITE $tools_suite_name CASE ($full_tag) $name "
		log_message "TEST SUITE $tools_suite_name CASE ($full_tag) $name:"
		log_message "$information\n"
		log_message "[date_stamp]"
		log_message ""
	}

	# test for tag or test_suite_tag.test_case_tag in TEST_CASES/TEST_SKIP_CASES
	if { $tools_suite_status == "skip"
	     || [ check_skip_test TEST_CASES TEST_SKIP_CASES "{$tag} {$full_tag}" ] } {
		test_execute {} {
			show_message "SKIPPED"
			log_message ""
			log_restore
		}
		set tools_case_status "skip"
		incr tools_case_skipped
		remove_test_tmp
		if { $tools_suite_status == "skip" } {
			return 1
		} else {
			return 0
		}
	}

	# only identify cases which are not skipped
	if { [ identify_mode ] } {
		puts "------------------------------------------------------------------------------"
		# puts "Test Suite: $tools_suite_name ($tools_suite_tag)"
		puts "Test Case: $name ($full_tag)"
		puts "$information\n"
	}

	set res [ catch {
		set expecting ""
		set_timeout 60
		if { [ catch { eval $startup } err_str2 ] != 0 } {
			error "case_setup failed: $err_str2"
		} elseif { "$err_str2" == -1} {
                        # skip test_case and do not run cleanup proc
                        set tools_case_status "skip"
                        set res 1
                    } else {
                        set expecting ""
                        set_timeout 60
                        # the handling of TEST_IDENTIFY for test_items within
	            	# a test_case is TBD, at this time, they are ignored.
         		test_execute {} { eval $code }
                }
	} err_str ] 

	set did_cleanup 0
	if { $res != 0 && $tools_case_status == "skip" } {
		# clear result, we will run cleanup for skipped
		set res 0
	}
	if { $res == 0 } {
		set expecting ""
		set_timeout 60
		if { "$cleanup" != "" && "$cleanup" != "noop"
		     && [ catch { eval $cleanup 0 } err_str2 ] != 0 } {
			set err_str "$cleanup function FAILED: $err_str2"
			set res 1
		}
		set did_cleanup 1
	}
	if { $res == 0 && $tools_item_failed != 0 } {
		set err_str "$tools_item_failed test items FAILED"
		set res 1
	}
	if { $res != 0 && ! [ identify_mode ] } {
		# output message immediately after failure to make reading
		# log easier, also output immediately before FAILED message
		log_message "\nTEST CASE FAILURE=$err_str"
		if { ! $did_cleanup && "$failure_code" != "" } {
			set expecting ""
			set_timeout 60
			if { [ catch { eval $failure_code } err_str2 ] != 0 } {
				log_message "failure handling code FAILED: $err_str2"
			}
		}
		set expecting ""
		set_timeout 60
		if { ! $did_cleanup && "$cleanup" != "" && "$cleanup" != "noop"
		     && [ catch { eval $cleanup 1 } err_str2 ] != 0 } {
			log_message "$cleanup function FAILED: $err_str2"
		}
		cleanup_all_children
		log_message "\nFAILURE=$err_str"
		test_item_totals
		clear_item_counters
		puts "FAILED"
		log_message "\n[date_stamp]\n"
		log_message "\nTEST SUITE $tools_suite_name CASE ($full_tag) $name: FAILED\n"
		set tools_suite_result "FAILED"
		incr tools_case_failed
		set tools_case_status "fail"
		log_restore
		save_test_tmp $tools_suite_tag $tag TEST_SAVE_FAILED
		set stop_failed [test_get_env TEST_STOP_FAILED]
		if { "$stop_failed" == "case" || "$stop_failed" == "any" } {
			fail_suite "test failed with TEST_STOP_FAILED set" $stop_failed
		} else {
			return 1
		}
	} else {
		cleanup_all_children
		test_execute {} {
			test_item_totals
			if { $tools_case_status == "skip" } {
				incr tools_case_skipped
				set status "SKIPPED: $err_str"
			} elseif {$tools_item_count && $tools_item_skipped == $tools_item_count } {
				# all items were skipped, report case as skipped
				incr tools_case_skipped
				set status "SKIPPED"
			} else {
				incr tools_case_passed
				set status "PASSED"
			}
			puts "$status"
			log_message "\n[date_stamp]\n"
			log_message "\nTEST SUITE $tools_suite_name CASE ($full_tag) $name: $status\n"
			log_restore
			save_test_tmp $tools_suite_tag $tag TEST_SAVE_TEMP
		}
		clear_item_counters
		return 0
	}
}

proc test_item_totals { } {
# if there were test_items in this test_case, report the test item
# statuses and the totals
# and re-output the test_case details for the PASSED/FAILED message to come
	global tools_item_count
	global tools_item_passed
	global tools_item_started
	global tools_item_failed
	global tools_item_skipped
	global tools_case_async
	global tools_case_name
	global tools_case_tag
	global tools_suite_name
	global tools_item_status_list

	if { $tools_item_count > 0 } {
		foreach message $tools_item_status_list {
			show_message $message
		}
		if { $tools_case_async } {
			set message "TEST CASE $tools_case_name: $tools_item_count Items; $tools_item_started STARTED"
			if { $tools_item_passed != 0 } {
				append message "; $tools_item_passed PASSED"
			}
			if { $tools_item_failed != 0 } {
				append message "; $tools_item_failed FAILED"
			}
		} else {
			set message "TEST CASE $tools_case_name: $tools_item_count Items; $tools_item_passed PASSED"
			if { $tools_item_failed != 0 } {
				append message "; $tools_item_failed FAILED"
			}
		}
		if { $tools_item_skipped != 0 } {
			append message "; $tools_item_skipped SKIPPED"
		}
		show_message "$message"
		puts -nonewline "TEST SUITE $tools_suite_name CASE ($tools_case_tag) $tools_case_name "
	}
}

# initialize when first load this module
set test_tmp "test_tmp[pid]"

proc make_test_tmp { } {
# create the test_tmp directory

	global test_tmp

	# set here in case sub-process in a parallel execution set of tests
	set test_tmp "[test_get_env TEST_RESULT_DIR]/test_tmp[pid]"
	catch { exec rm -rf $test_tmp }
	exec mkdir $test_tmp
}

proc test_get_env { envvar } {
##
## test_get_env
## --------------
## get given env var value, if not exported, returns value of default_$envvar
##
## Arguments:
##	envvar - variable name to get value for
## Returns:
##	value to use for variable

	global env
	global default_$envvar

	if { [ info exists env($envvar)] } {
		return $env($envvar)
	} else {
		return [ set default_$envvar ]
	}
}

proc test_check_yn { value } {
##
## test_check_yn
## --------------
## determine if value is yes (or y) or no
##
## Arguments:
##	value - value to check
## Returns:
##	1 - yes
##	0 - no (or invalid value)

	return [ string match {[yY]*} $value ]
}


proc test_save_temp { } {
##
## test_save_temp
## --------------
## return if TEST_SAVE_TEMP behaviour should be performed
##
## Returns:
##	1 - yes
##	0 - no

	return [ test_check_yn [ test_get_env TEST_SAVE_TEMP] ]
}

proc save_test_tmp { suite_tag case_tag envvar } {
# save the test_tmp directory to save_tmp/$suite_tag/$case_tag
# if $env(envvar) is yes

	global env
	global test_tmp

	set save_tmp [test_get_env TEST_RESULT_DIR]/save_tmp

	if { [ test_check_yn [ test_get_env TEST_SAVE_FIRST ] ] 
		 && [ file exists $save_tmp/$suite_tag/$case_tag ] } {
		log_message "$test_tmp not saved due to existing $save_tmp/$suite_tag/$case_tag with TEST_SAVE_FIRST enabled"
		catch { exec rm -rf $test_tmp }
		return
	}
	catch { exec rm -fr $save_tmp/$suite_tag/$case_tag }
	if { [ test_check_yn [ test_get_env $envvar ] ] } {
		log_message "$test_tmp saved to $save_tmp/$suite_tag/$case_tag"
		if { [ file exists $save_tmp ] != 1 } {
			exec mkdir -p $save_tmp
		}
		if { [ file exists $save_tmp/$suite_tag ] != 1 } {
			exec mkdir -p $save_tmp/$suite_tag
		}
		exec mv $test_tmp $save_tmp/$suite_tag/$case_tag
	} else {
		catch { exec rm -rf $test_tmp }
		# rmdir can fail if directory not empty, thats ok
		catch { exec rmdir $save_tmp/$suite_tag }
	}
}

proc remove_test_tmp { } {
# remove the test_tmp directory

	global test_tmp

	catch { exec rm -rf $test_tmp }
}

proc check_skip_test { envvar skipenvvar match_list } {
#
# check_skip_test
# -------------------
# determine if the current test should be skipped
#
# Usage:
#	check_skip_test
#
# Arguments:
#	envvar - environment variable to base tests on (TEST_SUITES, TEST_CASES
#		or TEST_ITEMS)
#	skipenvvar - environment variable to base skipping tests on
#		(TEST_SKIP_SUITES, TEST_SKIP_CASES or TEST_SKIP_ITEMS)
#	match_list - list of tags to attempt to match against each entry in
#		the environment variable
# Returns:
#	1 - this test should be skipped
#	0 - this test should be executed
# Additional Information:
#	If a tag in match_list matches both envvar and skipenvvar, 1 is returned

	global env

	set result 0

	if { [ info exists env($envvar) ] } {
		# limit to those we find in envvar
		set result 1
		foreach item $env($envvar) {
			foreach tag $match_list {
				if { [ string match $item $tag ] } {
					set result 0
				}
			}
		}
	}
	if { $result == 1 } {
		# already decided to skip, no need to test skipenvvar
		return $result
	}
	if { [ info exists env($skipenvvar) ] } {
		# skip those we find in skipenvvar
		foreach item $env($skipenvvar) {
			foreach tag $match_list {
				if { [ string match $item $tag ] } {
					set result 1
				}
			}
		}
	}
	return $result
}

proc test_parallel { } {
##
## test_parallel
## --------------
## determine if parallel tests should be run based on TEST_PARALLEL and
## TEST_IDENTIFY
##
## Returns:
##	1 - yes
##	0 - no

#
# If this version of TCL has thread support enabled, disable
# parallel operations, because thread support causes hangs
# in TCL fork processing.
#

	global tcl_platform
	#if { [ catch { set thread_tcl $tcl_platform(threaded) } result] } {
		set thread_tcl 0
	#}

	return [ expr ! [identify_mode] \
			&& [ test_check_yn [ test_get_env TEST_PARALLEL] ] \
			&& [ test_get_env TEST_MAX_PARALLEL ] > 1 \
			&& {$thread_tcl == 0 } ]
}

proc test_item { tag name information startup cleanup code { failure_code "" }} {
##
## test_item
## ---------
## This executes the given test item
##
## Usage:
##	test_item tag "test name" "test description" startup cleanup {
##		code for test
##	}
## Arguments:
##	tag - short tag for test case, no spaces or special characters allowed
##		used to name directory to save results
##	name = test case name
##	information = brief description of test
##	code = Tcl commands for test item (typically a list)
##	startup - procedure to execute at start of the test item
##	cleanup - procedure to execute at the end of the test item
## Returns:
##	0 - test success or explicitly skipped
##	1 - test failure or skipped due to earlier fail_suite
## Additional Information:
##	In general the code should avoid doing output such that the
##	output will simply include test items and PASS/FAIL status
##	Any error returns within $code will indicate a test failure.
##	In general, fail_test should be invoked to indicate such failures.
##	Any detailed logging of test progress should be done using log_message
##
##	Its typical use is to extract additional information into test_tmp
##	to aid the debug of why the test item failed
##	The log during the test item is kept in test_tmp/test.log (and
##	saved based on TEST_SAVE_FAILED) and at the end of the test item it is
##	appended to the main test.log

	global tools_suite_name
	global tools_suite_tag
	global tools_suite_result
	global tools_suite_count
	global tools_suite_status
	global tools_case_name
	global tools_case_tag
	global tools_name_name
	global tools_name_tag
	global tools_item_count
	global tools_item_passed
	global tools_item_started
	global tools_item_failed
	global tools_item_skipped
	global tools_item_status
	global tools_case_async
	global tools_case_status
	global tools_item_tag_list
	global tools_item_full_tag_list
	global tools_item_name_list

	global env
	# force spawn_id returned by any spawn's within $code to be global
	global spawn_id
	global spawn_out
	global interact_out
	global expect_out
	global timeout
	global expecting
	global features

	if { $tools_item_count == 0 } {
		# newline after TEST CASE name line
		puts "..."
	}

	incr tools_item_count

	set tools_item_result "PASSED"
	set tools_item_status "okay"

	set full_tag "$tools_case_tag\.$tag"
	set tools_item_name "$name"
	set tools_item_tag "$full_tag"

	puts -nonewline "TEST SUITE $tools_suite_name ITEM ($full_tag) $name "
	log_message "TEST SUITE $tools_suite_name ITEM ($full_tag) $name:"
	log_message "$information\n"
	log_message "[date_stamp]"
	log_message ""

	# test for tag or test_suite_tag.test_case_tag.test_item_tag
	# in TEST_ITEMS
	if { $tools_suite_status == "skip"
	     || [ check_skip_test TEST_ITEMS TEST_SKIP_ITEMS "{$tag} {$full_tag}" ] } {
		show_message "SKIPPED"
		log_message ""
		incr tools_item_skipped
		set tools_item_status "skip"
		if { $tools_suite_status == "skip" } {
			return 1
		} else {
			return 0
		}
	}

	set res [ catch {
		set expecting ""
		set_timeout 60
		if { [ catch { uplevel $startup } err_str2 ] != 0 } {
			error "item_setup failed: $err_str2"
		} elseif { "$err_str2" == -1} {
                        # skip test_item and do not run cleanup proc
                        set tools_item_status "skip"
                        set res 1
                } else {
                        set expecting ""
                        set_timeout 60
                        uplevel $code
                }
	} err_str ]
	if { $res != 0 && ( $tools_item_status == "skip" || $tools_case_status == "skip" ) } {
		# clear result, we will run cleanup for skipped
		set res 0
	}
	set did_cleanup 0
	if { $res == 0 } {
		set expecting ""
		set_timeout 60
		if { "$cleanup" != "" && "$cleanup" != "noop"
		     && [ catch { eval $cleanup 0 } err_str2 ] != 0 } {
			set err_str "$cleanup function FAILED: $err_str2"
			set res 1
		}
		set did_cleanup 1
	}
	if { $res != 0 } {
		# output message immediately after failure to make reading
		# log easier, also output immediately before FAILED message
		log_message "\nFAILURE=$err_str"
		if { ! $did_cleanup && "$failure_code" != "" } {
			set expecting ""
			set_timeout 60
			if { [ catch { uplevel $failure_code } err_str2 ] != 0 } {
				log_message "failure handling code FAILED: $err_str2"
			}
		}
		set expecting ""
		set_timeout 60
		if { ! $did_cleanup && "$cleanup" != "" && "$cleanup" != "noop"
		     && [ catch { uplevel $cleanup 1 } err_str2 ] != 0 } {
			log_message "$cleanup function FAILED: $err_str2"
		}
		log_message "\nFAILURE=$err_str"
		puts "FAILED"
		log_message "\n[date_stamp]\n"
		log_message "\nTEST SUITE $tools_suite_name ITEM ($full_tag) $name: FAILED\n"
		set tools_suite_result "FAILED"
		incr tools_item_failed
		set tools_item_status "fail"
		set stop_failed [test_get_env TEST_STOP_FAILED]
		if { "$stop_failed" == "any" } {
			fail_suite "test failed with TEST_STOP_FAILED set" $stop_failed
		} else {
			return 1
		}
	} else {
		if { $tools_case_async } {
			set status "STARTED"
			incr tools_item_started
			lappend tools_item_tag_list "$tag"
			lappend tools_item_name_list "$name"
			lappend tools_item_full_tag_list "$full_tag"
		} else {
			if { $tools_item_status == "skip" || $tools_case_status == "skip" } {
				set status "SKIPPED: $err_str"
				incr tools_item_skipped
			} else {
				set status "PASSED"
				incr tools_item_passed
			}
		}
		puts "$status"
		log_message "\n[date_stamp]\n"
		log_message "\nTEST SUITE $tools_suite_name ITEM ($full_tag) $name: $status\n"
		if { $tools_case_status == "skip" } {
			# pass exception up so rest of test case is skipped
			error "$err_str" "$err_str"
		}
		return 0
	}
}

proc async_case {} {
##
## async_case
## ----------
## Indicate that the test_items in the current test case run asynchronously
##
## Usage:
##	async_case
## Additional Information:
##	This causes the test_item to report FAILED (and but counts) or
##	Started.  If it expected that later code in the test_case
##	(typically the cleanup routine) will invoke the test_item_status
##	routine to indicate the pass/fail status for each test item
##	for inclusion in the test.res report.
	global tools_case_async

	set tools_case_async 1
	log_message "Asynchronously run test items for this test case"
}

# initialize value when source is first autosourced in
global tools_case_async
set tools_case_async 0

proc get_async_case {} {
##
## get_async_case
## ----------
## return current value for async_case as set via async_case call
##
## Usage:
##	get_async_case

	global tools_case_async

	return $tools_case_async 
}

proc test_item_status { item_info } {
##
## test_item_status
## ----------------
## Report the status for a test item in an asynchronously executed test case
##
## Usage:
##	test_item_status item_info
## Arguments:
##	info_info:
##		test_item_tag status
##			test_item_tag - tag provided to test_item call
##			status - status of test item (PASSED/FAILED/SKIPPED)
## Additional Information:
##	test_item_tags not found in the tools_item_tag_list are assumed to
##		have already been reported on.  This is maintains the
##		list of test_items which have been successfully started
##		but not yet reported status for
##

	global tools_item_passed tools_item_failed tools_item_skipped
	global tools_item_tag_list
	global tools_item_full_tag_list
	global tools_item_name_list tools_suite_name
	global tools_item_status_list

	set test_item_tag [ lindex $item_info 0 ]
	set status [ lindex $item_info 1 ]

	set index [ lsearch -exact $tools_item_tag_list $test_item_tag ]
	if { $index == -1 } {
		return
	}
	set name [ lindex $tools_item_name_list $index ]
	set full_tag [ lindex $tools_item_full_tag_list $index ]
	set tools_item_tag_list [ lreplace $tools_item_tag_list $index $index ]
	set tools_item_name_list [ lreplace $tools_item_name_list $index $index ]
	set tools_item_full_tag_list [ lreplace $tools_item_full_tag_list $index $index ]
	if { "$status" == "PASSED" } {
		incr tools_item_passed
	} elseif { "$status" == "SKIPPED" } {
		incr tools_item_skipped
	} else {
		incr tools_item_failed
	}
	lappend tools_item_status_list "TEST SUITE $tools_suite_name ITEM ($full_tag) $name $status"
}

proc fail_test { info } {
##
## fail_test
## ---------
## abort the current test and indicate a failure to test_case
##
## Usage:
##	fail_test info
## Arguments:
##	info - a brief comment as to why the test failed, typically what
##		was received by expect that wasn't expected ( ie. "eof")
## Returns:
##	error exception
## Additional Information:
##	This procedure should be called anytime a test case detects a failure
##	The error return will cause the stack to unwrap all the way up to
##	test_case (which should be the only error trap in the stack)
##	Note that an alternative to using this routine is to simply have an
##	error return (return -code error or a failed tcl command) within the
##	test case code block.
##	However this has the advantage of logging "$info" to the test.log

	log_message "\nERROR: $info"
	error "$info" "$info"
}

proc fail_suite { info { abort_now 1 } } {
##
## fail_suite
## ---------
## abort the current test suite and indicate a failure
##
## Usage:
##	fail_suite info [abort_now]
## Arguments:
##	info - a brief comment as to why the test suite failed
##	abort_now - 0/1 should the suite abort immediately or
##		simply ignore all test_cases calls until end_suite
##		default is 1
## Returns:
##	abort_now = 0 -> nothing
##	abort_now = 1 -> error exception
## Additional Information:
##	Typically used when global environment requirements are not met
##	or when subsequent test cases depend on the success of a prior test case
##
##	This routine can only be called within a test_suite code block.
##
##	If abort_now is 1, the code block aborts immediately.
##
##	However if it is 0, the test_suite code block will continue to be
##	executed, however all test_case invocations within the code block will
##	be ignored.
##
##	In general abort_now should be 1.
##
##	Only if there is special cleanup code between tests (which really
##	should be done by the cleanup code supplied to test_suite) should
##	abort_now be 0.

	global tools_suite_name
	global tools_suite_result
	global tools_suite_status
	global tools_suite_failed

	show_message "\nTEST SUITE FAILURE: $info"
	show_message "TEST SUITE $tools_suite_name TESTS ABORTED"
	log_message ""
	set tools_suite_result "FAILED"
	incr tools_suite_failed
	if { $abort_now == 1 } {
		set tools_suite_status "abort"
		error "$info" "$info"
	} else {
		set tools_suite_status "skip"
		return
	}
}

proc skip_case { info } {
##
## skip_case
## ---------
## stop the current test case and indicate it was skipped
##
## Usage:
##	skip_case info
## Arguments:
##	info - a brief comment as to why the test case was skipped
## Returns:
##	does not return, throws and exception
## Additional Information:
##	Typically used when global environment requirements are not met
##	or when subsequent test cases depend on the success of a prior test case
##
##	This routine can only be called within a test_case code block.
##	If called within a test_item, the rest of the test case will be skipped
##	Of course if the item is within a parallel block, the skip will only
##	affect other items within the same subprocess. For example:
##		test_case {
##			parallel x { a b c } {
##				test_item 1$x
##				test_item 2$x
##			}
##		}
##	A skip_case within item 1a will only affect item 2a, it will not affect
##	1b, 1c, 2b, 2c. However the final results for the case will be tabulated
##	as 2 skipped, 4 passed (or failed)
##

	global tools_case_status

	# test_case (or test_item) will catch exception and report to log and stdout
	log_message ""
	set tools_case_status "skip"
	error "$info" "$info"
}

proc skip_item { info } {
##
## skip_item
## ---------
## stop the current test item and indicate it was skipped
##
## Usage:
##	skip_item info
## Arguments:
##	info - a brief comment as to why the test item was skipped
## Returns:
##	does not return, throws and exception
## Additional Information:
##	Typically used when global environment requirements are not met
##	or when subsequent test items depend on the success of a prior test item
##
##	This routine can only be called within a test_item code block.
##

	global tools_item_status

	# test_item will catch exception and report to log and stdout
	log_message ""
	set tools_item_status "skip"
	error "$info" "$info"
}

proc clear_case_counters {} {
# clear counters for cases and items completed within a test suite
	global tools_case_count 0
	global tools_case_passed 0
	global tools_case_failed 0
	global tools_case_skipped 0

	set tools_case_count 0
	set tools_case_passed 0
	set tools_case_failed 0
	set tools_case_skipped 0
	clear_item_counters
}

proc clear_item_counters {} {
# clear counters for items completed within a test case
	global tools_item_count 0
	global tools_item_started 0
	global tools_item_passed 0
	global tools_item_failed 0
	global tools_item_skipped 0

	set tools_item_count 0
	set tools_item_started 0
	set tools_item_passed 0
	set tools_item_failed 0
	set tools_item_skipped 0
}

# set of counters which are saved and passed across process boundary
# during parallel execution on completion of a sub-process
set saved_counters { suite_count suite_failed
			 case_count case_passed case_failed case_skipped
			 item_count item_started item_passed item_failed item_skipped}

proc tools_clear_saved_counters {} {
# clear all counters, utility function to aid counter management during
# parallel execution, by clearing counters we can identify the changes
# which occurred in a sub-process for ultimate tabulations back into
# the parent processes counters
#
# case_status and item_status are text values, not counters

	global saved_counters
	global tools_case_status
	global tools_item_status

	foreach counter $saved_counters {
		global tools_$counter
		set tools_$counter 0
	}
	set tools_case_status "okay"
	set tools_item_status "okay"
}

proc tools_save_counters { {errorcode 0} {errorinfo ""} } {
#
# output all counters to a [pid] based file
# Used for parallel test execution in sub-processes
#
# Arguments:
#	errorcode - 0/1, should an error be propigated back to parent process
#	errorinfo - info to pass back to parent in thrown error, only used if
#		errorcode is 1

	global saved_counters
	global tools_case_status
	global tools_item_status

	set filename "/tmp/testcount.[pid]"
	catch { eval exec rm -f $filename }
	set fileid [ open $filename "w" ]
	if { [ catch {
		foreach counter $saved_counters {
			global tools_$counter
			puts $fileid "$counter [set tools_$counter]"
		}
		puts $fileid "case_status $tools_case_status"
		puts $fileid "item_status $tools_item_status"
		puts $fileid "errorcode $errorcode"
		# errorinfo must be the last counter, $errorinfo could be multi-line string
		puts $fileid "errorinfo $errorinfo"
	} res ] != 0 } {
		show_message "save_counters failed: $res"
		catch { close $fileid }
		# remove file so parent recognizes a critical failure in child
		catch { eval exec rm -f $filename }
	} else {
		catch { close $fileid }
	}
}

proc tools_clear_tmp_counters {} {
#
# clear the counters into which tools_update_tmp_counters adds its totals

	global tools_tmp_exit
	global saved_counters
	global tools_tmp_case_status
	global tools_tmp_item_status
	global tools_tmp_errorcode
	global tools_tmp_errorinfo

	set tools_tmp_exit 0
	foreach counter $saved_counters {
		global tools_tmp_$counter
		set tools_tmp_$counter 0
	}
	set tools_tmp_case_status "okay"
	set tools_tmp_item_status "okay"
	set tools_tmp_errorcode 0
	set tools_tmp_errorinfo ""
}

proc tools_update_tmp_counters { pid } {
#
# fetch counters created by tools_save_counters and update tools_tmp_*
	global env
	global tools_tmp_case_status
	global tools_tmp_item_status
	global tools_tmp_errorcode
	global tools_tmp_errorinfo
	global tools_tmp_exit

	set filename "/tmp/testcount.$pid"
	if { ! [ file exists "$filename" ] } {
		set tools_tmp_exit 1
		return
	}
	set fileid [ open $filename "r" ]
	if { [ catch {
		while { [ gets $fileid line ] != -1 } {
			set counter [ lindex $line 0 ]
			set value [ lreplace $line 0 0 ]
			if { "$counter" == "case_status" } {
				if { "$value" == "skip"} {
					set tools_tmp_case_status $value
				}
			} elseif { "$counter" == "item_status" } {
				if { "$value" == "skip"} {
					set tools_tmp_item_status $value
				}
			} elseif { "$counter" == "errorcode" } {
				if { $value } {
					set tools_tmp_errorcode $value
				}
			} elseif { "$counter" == "errorinfo" } {
				if { "$value" != "" } {
					set tools_tmp_errorinfo "$value"
				}
				# rest of file could be part of a long error message
				while { [ gets $fileid line ] != -1 } {
					append tools_tmp_errorinfo "\n$line"
				}
			} else {
				global tools_tmp_$counter
				incr tools_tmp_$counter $value
			}
		}
		close $fileid
	} res ] != 0 } {
		catch { close $fileid }
		set tools_tmp_exit 1
	}
	catch { eval exec rm -f $filename }
}

proc tools_remove_tmp_counters { pid } {
#
# remove counters file created by tools_save_counters
	set filename "/tmp/testcount.$pid"
	catch { eval exec rm -f $filename }
}

proc add_item_counters { } {
# add tools_tmp_item_* to tools_item_*
	global tools_suite_result
	global tools_item_count
	global tools_item_started
	global tools_item_passed
	global tools_item_failed
	global tools_item_skipped
	global tools_tmp_item_count
	global tools_tmp_item_started
	global tools_tmp_item_passed
	global tools_tmp_item_failed
	global tools_tmp_item_skipped

	incr tools_item_count $tools_tmp_item_count
	incr tools_item_started $tools_tmp_item_started
	incr tools_item_passed $tools_tmp_item_passed
	incr tools_item_failed $tools_tmp_item_failed
	incr tools_item_skipped $tools_tmp_item_skipped
	if { $tools_tmp_item_failed > 0 } {
		set tools_suite_result "FAILED"
	}
}

proc add_case_counters { } {
# add tools_tmp_case_* to tools_case_* and add_item_counters
	global tools_suite_result
	global tools_case_count
	global tools_case_passed
	global tools_case_failed
	global tools_case_skipped
	global tools_tmp_case_count
	global tools_tmp_case_started
	global tools_tmp_case_passed
	global tools_tmp_case_failed
	global tools_tmp_case_skipped

	incr tools_case_count $tools_tmp_case_count
	incr tools_case_passed $tools_tmp_case_passed
	incr tools_case_failed $tools_tmp_case_failed
	incr tools_case_skipped $tools_tmp_case_skipped
	add_item_counters
	if { $tools_tmp_case_failed > 0 } {
		set tools_suite_result "FAILED"
	}
}

proc add_suite_counters { } {
# add tools_tmp_* to tools_*
	global tools_suite_count
	global tools_suite_failed

	incr tools_suite_count $tools_tmp_suite_count
	incr tools_suite_failed $tools_tmp_suite_failed
	add_case_counters
}

proc tools_check_process_results {} {
# check sub process results
# Returns:
#	1 - no failures which would justify a failure of parent
#	0 - failures which will result in failure of parent

	global tools_tmp_exit
	global tools_tmp_suite_count
	global tools_tmp_suite_failed
	global tools_tmp_case_count
	global tools_tmp_case_failed
	global tools_tmp_item_count
	global tools_tmp_item_failed
	global tools_tmp_case_status
	global tools_tmp_item_status
	global tools_tmp_errorcode
	global tools_tmp_errorinfo

	# beyond just adding counters, we simulate the effect of failures
	# by looking at the _count counters to determine what was started
	# within the parallel (to determine our context) and check

	if { $tools_tmp_exit } {
		return 0
	}
	if { $tools_tmp_suite_count > 0 } {
		# must have started test_suites within parallel block
	} elseif { $tools_tmp_case_count > 0 } {
		# must have started test_case's within an existing test_suite
		if { $tools_tmp_suite_failed } {
			return 0
		}
	} elseif { $tools_tmp_item_count > 0 } {
		# must have started test_item's within an existing test_case
		if { $tools_tmp_suite_failed || $tools_tmp_case_failed } {
			return 0
		}
	} else {
		# parallel code within an existing item or in a general script
		if { $tools_tmp_suite_failed || $tools_tmp_case_failed
			 || $tools_tmp_item_failed } {
			return 0
		}
	}
	# if we didn't find a failure above, but there was an error from
	# the sub-process
	if { $tools_tmp_errorcode } {
		return 0
	}
	return 1
}

proc tools_propigate_process_results {} {
#
# Used for parallel test execution, takes tools_tmp_* counters and updates
# tools_* counters and performs fail_test, fail_suite, or error as needed

	global tools_suite_count
	global tools_suite_failed
	global tools_case_count
	global tools_case_failed
	global tools_item_count
	global tools_item_failed
	global tools_tmp_exit
	global tools_tmp_suite_count
	global tools_tmp_suite_failed
	global tools_tmp_case_count
	global tools_tmp_case_failed
	global tools_tmp_item_count
	global tools_tmp_item_failed
	global tools_tmp_case_status
	global tools_tmp_item_status
	global tools_tmp_errorcode
	global tools_tmp_errorinfo

	# beyond just adding counters, we simulate the effect of failures
	# by looking at the _count counters to determine what was started
	# within the parallel (to determine our context) and check
	# failures to invoke the proper failure mechanism to cause the
	# appropriate global effect in the calling process
	if { $tools_tmp_exit } {
		# one of the count files was missing, process must have exited
		# we should do the same
		exit 1
	}
	if { $tools_tmp_suite_count > 0 } {
		# must have started test_suites within parallel block
		add_suite_counters
	} elseif { $tools_tmp_case_count > 0 } {
		# must have started test_case's within an existing test_suite
		add_case_counters
		if { $tools_tmp_suite_failed } {
			fail_suite "suite failure during parallel execution"
		}
	} elseif { $tools_tmp_item_count > 0 } {
		# must have started test_item's within an existing test_case
		add_item_counters
		if { $tools_tmp_suite_failed } {
			fail_suite "suite failure during parallel execution"
		}
		if { $tools_tmp_case_failed } {
			fail_test "case failure during parallel execution"
		}
		if { $tools_tmp_case_status == "skip" } {
			# case skipped within parallel execution
			skip_case "$tools_tmp_errorinfo"
		}
	} else {
		# parallel code within an existing item or in a general script
		if { $tools_tmp_suite_failed } {
			fail_suite "suite failure during parallel execution"
		}
		if { $tools_tmp_case_failed } {
			fail_test "case failure during parallel execution"
		}
		if { $tools_tmp_item_failed } {
			fail_test "item failure during parallel execution"
		}
		if { $tools_tmp_case_status == "skip" } {
			# case skipped within parallel execution
			skip_case "$tools_tmp_errorinfo"
		}
		if { $tools_tmp_item_status == "skip" } {
			# item skipped within parallel execution
			skip_item "$tools_tmp_errorinfo"
		}
	}
	# if we didn't find a failure above, but there was an error from
	# the sub-process, invoke the general error mechanism
	if { $tools_tmp_errorcode } {
		error "$tools_tmp_errorinfo" "$tools_tmp_errorinfo"
	}
}

proc show_more_lines { linecnt { id "" } } {
##
## show_more_lines
## ---------------
## show the next few lines from the spawned program's output
##
## Usage:
##	show_more_lines line_cnt [id]
## Arguments:
##	line_cnt - number of lines to attempt to show
##	id - spawn_id of child, default is global spawn_id
## Returns:
##	nothing
## Additional Information:
##	If a timeout or eof occurs before line_cnt lines are shown, this
##	procedure returns without an error

	global expect_out

	if { "$id" == "" } {
		global spawn_id
	} else {
		# use a local, expect_after isn't involved anyway
		# since we cover eof and default cases here
		set spawn_id $id
	}

	# local timeout variable is purposely used so that
	# any test_suite global settings are not altered
	set timeout 1
	for { set i 0 } { $i < $linecnt } { incr i } {
		expect {
			"\n"	noop
			eof	return
			default	break
		}
	}
	log_message ""
	return
}

proc log_message { string } {
##
## log_message
## -----------
## output an informative message
##
## Usage:
##	log_message string
## Arguments:
##	string - string to put to log, a newline will be appended
## Returns:
##	nothing
## Additional Information:
##	This will log the given string to the log_file, if there is
##	no current log_file, it is output to stdout
##	This should be used for all detailed output routines within
##	test scripts or utility procedures.  The case were it sends output
##	to stdout, allows for interactive execution of commands which use this
##	Otherwise, within a typical expect test script, the log_file will get
##	the detailed output and stdout will only get brief messages
##
##	This adds a newline at the end of string
##
##	No output nor logging is generated for identify_mode

	global log_disable

	if { [ identify_mode ] } {
		return
	}
	if { [log_file -info] == "" } {
		if { ! $log_disable } {
			puts "$string"
		}
	} else {
		send_log "$string\n"
	}
	return
}

proc show_message { string } {
##
## show_message
## -----------
## output an informative message to stdout and the log
##
## Usage:
##	show_message string
## Arguments:
##	string - string to put to log and stdout, a newline will be appended
## Returns:
##	nothing
## Additional Information:
##	This will log the given string to the log_file, if there is one,
##	and stdout
##
##	This adds a newline at the end of string
##
##	No output nor logging is generated for identify_mode

	if { [ identify_mode ] } {
		return
	}
	if { [log_file -info] != "" } {
		send_log "$string\n"
	}
	puts "$string"
	return
}

proc show_performance { string } {
##
## show_performance
## -----------
## output performance results to stdout and the log
##
## Usage:
##	show_performance string
## Arguments:
##	string - string to put to log and stdout, a newline will be appended
##			and each newline will be preceeded with "PERF "
## Returns:
##	nothing
## Additional Information:
##	This will log the given string to the log_file, if there is one,
##	and stdout
##
##	This adds a newline at the end of string
##
##	No output nor logging is generated for identify_mode

	if { [ identify_mode ] } {
		return
	}
	regsub -all "\n" $string "\nPERF " message
	if { [log_file -info] != "" } {
		send_log "PERF $message\n"
		send_log "PERF ---------------------------------------------------------------------------\n"
	}
	puts "PERF $message"
	puts "PERF ---------------------------------------------------------------------------\n"
	return
}

proc noop {} {
##
## noop
## ----
## do nothing procedure
##
## Usage:
##	noop
## Returns:
##	nothing
## Additional Information:
##	useful as the body for expect commands when the pattern needs no special
##	execution

	return
}

proc expect_eof { timelimit  { ignore_rest 0 } } {
##
## expect_eof
## ----------
## utility procedure to check for eof
##
## Usage:
##	expect_eof timelimit [ignore_rest]
## Arguments:
##	timelimit - maximum time to wait
##	ignore_rest - ignore any data prior to eof (default 0)
##				if 0 any data received before eof is an error
## Returns:
##	eof found - nothing
##	eof not found - error exception
## Additional Information:
##	This is designed for use within test_case's $code
##	After getting eof, it makes sure the child is terminated
##	by waiting and/or killing child as needed
##	The global timeout is saved, changed and restored by this routine

	global spawn_id
	global expect_out
	global timeout
	global expecting
	global env

	set save_timeout $timeout

	set_timeout $timelimit

	set expecting "EOF"
	if { [ info exists env(TESTDEBUG) ] } {
		log_message "DEBUG: expecting EOF"
	}

	expect {
		eof	noop
		"?*"	{ if { ! $ignore_rest } {
					log_message "\nERROR: expected: EOF"
			  		log_message "\nERROR: Unexpected data: $expect_out(buffer)"
			  		fail_test "Unexpected data"
				  } else {
					exp_continue
				  }
			}
		timeout	{ 
				log_message "\nERROR: timeout ($timeout) waiting for: EOF"
				# get buffered data
				expect *
				if { "$expect_out(buffer)" != "" } {
					log_message "\nERROR: timeout: Received data: $expect_out(buffer)"
					fail_test "timeout: with data"
				} else {
					fail_test "timeout: No data"
				}
			}
		default	{ log_message "\nERROR: expected: EOF"
			  fail_test "default"
			}
	}
	# make sure child terminates
	stop_child $spawn_id

	set timeout $save_timeout

	return
}

proc ignore_rest {} {
##
## ignore_rest
## -----------
## utility procedure to ignore the rest of the output
## by waiting and/or killing child as needed
##
## Usage:
##	ignore_rest
## Returns:
##	nothing
## Additional Information:
##	This is designed for use within test_case's $code

	# make sure child terminates
	child_cleanup
	return
}

proc run_cmd { cmd } {
##
## run_cmd
## -------
## utility procedure to run a command with error logging
##
## Usage:
##	run_cmd cmd
## Typical Usage:
##	run_cmd {exec some_shell_command}
## Returns:
##	output from command on success
## Additional Information:
##	If the given command fails, it is logged along with the output
##	from the command and an error is generated
##	This is designed for use within test_case's $code

	global spawn_id
	global spawn_out
	global interact_out
	global expect_out
	global timeout
	global expecting
	global env

	if { [ info exists env(TESTDEBUG) ] } {
		log_message "DEBUG: run_cmd $cmd"
	}
	if { [catch { eval $cmd } string] == 1 } {
		set info "Command failed: $cmd"
		log_message "$info"
		log_message "$string"
		error "$info" "$info"
	} else {
		return "$string"
	}
}

proc compare_files { file1 file2 } {
##
## compare_files
## -------------
## utility procedure to compare 2 ascii files
##
## Usage:
##	compare_files file1 file2
## Returns:
##	match - nothing
##	mismatch - error exception
## Additional Information:
##	This is designed for use within test_case's $code
##	It causes an error exception if the files do not match

	log_message "Comparing $file1 to $file2"
	run_cmd "exec diff $file1 $file2"
	return
}

proc compare_tdiff_files { file1 file2 } {
##
## compare_tdiff_files
## ---------------------
## utility procedure to compare a file against a pattern/template using tdiff
##
## Usage:
##	compare_tdiff_files file1 file2
## Returns:
##	match - nothing
##	mismatch - error exception
## Additional Information:
##	This is designed for use within test_case's $code
##	It causes an error exception if the files do not match

	log_message "Comparing template $file1 to $file2"
	run_cmd "exec tdiff $file1 $file2"
	return
}

proc compare_binary_files { file1 file2 } {
##
## compare_binary_files
## --------------------
## utility procedure to compare 2 binary files
##
## Usage:
##	compare_files file1 file2
## Returns:
##	match - nothing
##	mismatch - error exception
## Additional Information:
##	This is designed for use within test_case's $code
##	It causes an error exception if the files do not match

	log_message "Comparing Binary $file1 to $file2"
	run_cmd "exec cmp $file1 $file2"
	return
}

proc match_files { range_list template_list file_list } {
##
## match_files
## -----------
## allow a set of templates and data_files to be matched in any combination
##
## Usage:
##	match_files range_list template_list datafile_list
## Arguments:
##	range_list - a list of ranges.  Each indicates the number of times
##		each template must be matched.
##		The number of range_list elements can't exceed
##		the number of template_list elements.  If ranges are not
##		provided for all template_list elements, the additional
##		template_list elementswill all have the last range provided.
##		If the range_list is empty, the default is "1"
##		A given range list element cannot include any spaces or tabs.
##		Format (X and Y are positive integers):
##			X	expect exactly this many matches of command
##			X-Y	Allow up to Y matches, require X matches.
##			X- 	Similar to X-Y, but Y is infinite.
##		The special range "m" may be included at the start of the
##		list to indicate that every template_list entry which has
##		not yet reached its maximum match count should be applied
##		against the data_file.
##	template_list - a list of tdiff template files to be matched.
##	datafile_list - a list of tdiff data files to be matched against the
##		templates.
## Returns:
##	match - "matched"
##	mismatch - error exception
##	invalid args - error exception
## Additional Information:
##	If the template_files are not each matched the required minimum
##	times, this routine returns with an error exception.
##
##	For each data file, the template files are processed in the
##	order provided.  Once a given template file has matched its maximum
##	number of occurances (Y), it is no longer executed against
##	subsequent data files.
##
##	If some of the ranges are not 1, it is valid to have the number of
##	elements in the file_list differ from the number of elements in
##	the template_list.
##
##	The special m range parallels the tdiff %orderless -m option.
##	This allows every unmaxed template to be applied against each data_file
##	This can be especially useful for protocols such as SMTP which may
##	handle multiple recipient distributions by sending 1 distribution with
##	all the recipients or multiple distributions with various subsets of
##	the recipient list.
##	In which case, a template file should exist to match a distribution
##	with the given recipient (and possibly others) and that list could
##	be applied against the distributions received to verify that
##	all the recipients got mail.
#
#	local variables:
#		scoreboard(#) - count that template_list element # has matched
#		range_min(#), range_max(#) - range values for template_list
#				element #

	log_message "Matching files { $range_list } { $template_list } { $file_list }"

	set num_data_files [llength $file_list]
	set num_template_files [llength $template_list]
	set num_ranges [llength $range_list]
	set match_many 0

	if { $num_template_files == 0 } {
		set info "match_files: empty template_list"
		error "$info" "$info"
	}

	if { $num_ranges >= 1 && [lindex $range_list 0] == "m" } {
		set match_many 1
		incr num_ranges -1
		if { $num_ranges > 0 } {
			set range_list [lrange $range_list 1 $num_ranges]
		} else {
			set range_list {}
		}
	}

	if { $num_template_files < $num_ranges } {
		set info "match_files: range_list larger than template_list"
		error "$info" "$info"
	}

	set last_range_min 1
	set last_range_max 1

	for { set i 0 } { $i < $num_template_files } { incr i } {
		if { $i >= $num_ranges } {
			set range_min($i) $last_range_min
			set range_max($i) $last_range_max
		} else {
			parse_range [lindex $range_list $i] range_min($i) range_max($i)
			set last_range_min $range_min($i)
			set last_range_max $range_max($i)
		}
		set scoreboard($i) 0
	}
	foreach data_file $file_list {
		set match 0;	# has this data_file been matched yet
		set allmin 1;	# assume all matched at minimum
		set allmax 1;	# assume all matched at maximum

		for { set i 0 } { $i < $num_template_files } { incr i } {
			set template_file [lindex $template_list $i]
			if { $range_max($i) != -1
			     && $scoreboard($i) >= $range_max($i) } {
				# debug output
				# puts "match_files: template $template_file reached max ($range_max($i))"
				continue
			}
			if { ! $match || $match_many } {
				if { [ catch { exec tdiff $template_file $data_file } ] == 0 } {
					# file match
					incr scoreboard($i)
					set match 1
					log_message "$data_file matched by $template_file"
				}
			}
			if { $allmin && $scoreboard($i) < $range_min($i) } {
				set allmin 0
				# values for error message
				set not_min $template_file
				set not_min_cnt $range_min($i)
			}
			if { $range_max($i) == -1
			     || $scoreboard($i) < $range_max($i) } {
				set allmax 0
			}
		}
		# debug print
		# puts "allmin=$allmin allmax=$allmax match=$match"

		if { ! $match } {
			# no match found for any template
			if { $allmax } {
				set info "match_files: unable to match $data_file, all templates at maximum matches"
				error "$info" "$info"
			} else {
				set info "match_files: unable to match $data_file"
				error "$info" "$info"
			}
		}
	}

	if { ! $allmin } {
		# some template_files not matched minimum number of times
		set info "match_files: unable to match $not_min $not_min_cnt times"
		error "$info" "$info"
	}
	return matched
}

proc parse_range { range min_ref max_ref } {
# parse a range 
# Arguments:
#	range - range to parse
#	min_ref - name of variable to hold min
#	max_ref - name of variable to hold max
# Returns:
#	nothing
# Additional Information:
#	Fatal error on invalid range
#
	upvar $min_ref min
	upvar $max_ref max

	if { [regexp {[0-9]+-[0-9]+} $range] == 1 } {
		scan $range "%d-%d" min max
	} elseif { [regexp {[0-9]+-} $range] == 1 } {
		scan $range "%d-" min
		set max -1
	} elseif { [regexp {[0-9]+} $range] == 1 } {
		set min $range
		set max $min
		if { $min > $max } { 
			set info "Invalid range: $range"
			error "$info" "$info"
		}
	} else {
		set info "Invalid range: $range"
		error "$info" "$info"
	}
	return
}

proc build_file_list { filename_list } {
##
## build_file_list
## ---------------
## Build a list of filenames from a list of files/directories
##
## Arguments:
##	filename_list - list of file/directory names
## Returns:
##	list of non-directory files
##
## Additional Information:
##	All directory entries within filename_list are recursively searched
##	and replaced in the list with a list of all the non-directory files
##	found within them.
##
##	Note that the entire list is kept in memory.

	set file_list {}
	foreach filename $filename_list {
		if { [file isdirectory $filename] } {
			foreach filen [glob $filename/*] {
				set file_list [concat $file_list [build_file_list $filen]]
			}
		} else {
			set file_list [concat $file_list $filename]
		}
	}
	return $file_list
}

proc clean_file_list { filename_list } {
##
## clean_file_list
## ---------------
## delete the files in the file name list.  Used by
## tests that are long running enough
##
## Arguments:
##	filename_list - list of file/directory names
##
## Addtional Information:
##	Intended for use by tests that are long running enough to build
##	up an extreme number of send files.   Large directories cause
##      performance problems for stress tests that run for a long
##	time.
##
	set hit_list [ build_file_list $filename_list ]
	foreach file $hit_list {
		catch { eval exec rm -f $file [ glob -nocomplain $file.* ] }
	}
}

proc repeat_command { command file_list cnt_list } {
##
## repeat_command
## --------------
## execute a command repeatedly against a set of files
##
## Usage:
##	repeat_command command file_list cnt_list
## Arguments:
##	command - tcl command to execute (can include arguments if passed as
##		a list
##	file_list - list of files to supply to each execution of command
##			- note this really does not have to be a filelist
##			however that is the typical case
##	cnt_list - list of counts to apply to command
##		if the cnt_list has fewer elements than the file_list, the
##		last cnt_list entry is applied to the remaining file_list
##		entries.  An empty cnt_list is equivalent to { 1 } 
## Returns:
##	nothing
## Sample:
##	repeat_command { /etc/init.d/ics_srp} { restart } { 10}
##
##	This does the followingi 10 times:
##		/etc/init.d/ics_srp restart
##
##	repeat_command { fsck} { /dev/sdb /dev/sdc /dev/sdd } { 2 2 1}
##		fsck /dev/sdb /dev/sdc /dev/sdd
##		fsck /dev/sdb /dev/sdc
##	Note that per the count, /dev/sdd was omitted from the 2nd call
##
##	This command is very useful when counts are very large

	log_message "performing repeated operation: $command\n\ton { $file_list }\n\tfor { $cnt_list }"

	set num_files [llength $file_list]
	set num_cnt [llength $cnt_list]

	if { $num_files == 0 } {
		set info "repeat_command: empty file_list"
		error "$info" "$info"
	}

	if { $num_files < $num_cnt } {
		set info "repeat_command: cnt_list larger than file_list"
		error "$info" "$info"
	}

	set last_cnt 1
	set max_cnt 1

	# set up cnt(x) for each file_list entry
	for { set i 0 } { $i < $num_files } { incr i } {
		if { $i >= $num_cnt } {
			set cnt($i) $last_cnt
		} else {
			set cnt($i) [lindex $cnt_list $i]
			set last_cnt $cnt($i)
		}
		if { $last_cnt > $max_cnt } {
			set max_cnt $last_cnt
		}
	}

	# do the command max_cnt times
	for { set i 0 } { $i < $max_cnt } { incr i } {

		# build f_list with list of file_list elements to use
		set f_list {}
		for { set j 0 } { $j < $num_files } { incr j } {
			if { $i < $cnt($j) } {
				# [list ...] allows a file_list element to
				# be a list, in which case it is kept as
				# a list
				set f_list [concat $f_list [list [lindex $file_list $j]]]
			}
		}

		# execute command
		log_message "$command [list $f_list]\n"
		uplevel 1 $command [list $f_list]
	}
	return
}

proc scp_get_file { host usercode target_filename local_filename } {
##
## scp_get_file
## --------
## scp a file from the target system to the local system
##
## Usage:
##	scp_get_file host usercode target_filename local_filename
## Arguments:
##	host - host to connect to
##	usercode - usercode on that host
##	target_filename - file to get
##	local_filename - destination file on local system
    global env
    
    if { ! [ info exists env(CFG_SCP_FLAGS) ] } {
        set env(CFG_SCP_FLAGS) ""
    }
    
    #randomly wait up to a minute to alleviate many hosts attempting to scp files at once
    unix_cmd 150 0 "r=\$(( \$RANDOM % 60 + 1 )); sleep \$r"
    
	unix_cmd 400 0 "scp $env(CFG_SCP_FLAGS) $usercode@$host:/nfs/site/proj/stlbuilds/$target_filename $local_filename"
}

proc ftp_connect { host usercode password { do_spawn 1 } } {
##
## ftp_connect
## --------
## establish an ftp connection
##
## Usage:
##	ftp_connect host usercode password [do_spawn]
## Arguments:
##	host - host to connect to
##	usercode - usercode on that host
##	password - password on that host
##	do_spawn - should we spawn a expect session (eg. one not in progress already)
## Additional Information:

	global spawn_id
	global expect_out
	global spawn_out
	global timeout
	global expecting
	global env
	global stty_init

	# -i option will avoid y/n prompts in mget
	if { $do_spawn } {
		test_spawn "ftp -i" ftp -i $host
	} else {
		send_unix_cmd "ftp -i $host"
	}
	set timeout 120
	set expecting "ftp login sequence"
	expect {
		"Name*:"	{ exp_send "$usercode\n"
				  exp_continue
				}
		"assword:"	{ exp_send "$password\n"
				  exp_continue
				}
		"ftp: *
" {
				fail_test "ftp login failed"
				}
		"ftp> "		noop
	}
}

proc ftp_send_file { host usercode password local_filename target_filename {type "binary" } {do_spawn 1}} {
##
## ftp_send_file
## --------
## ftp a file from the local system to the specified target system
##
## Usage:
##	ftp_send_file host usercode password local_filename target_filename [type] [do_spawn]
## Arguments:
##	host - host to connect to
##	usercode - usercode on that host
##	password - password on that host
##	local_filename - file to send
##	target_filename - destination on host for file
##	type - type of file (ascii or binary).  Default is binary
##	do_spawn - should we spawn a expect session (eg. one not in progress already)

	global spawn_id
	global expect_out
	global spawn_out
	global timeout
	global expecting

	set save_timeout $timeout
	ftp_connect $host $usercode $password $do_spawn

	exp_send "$type\n"
	expect_list 60 { "ftp> " } { "Not connected" }

	# allow for large files
	exp_send "exp_send $local_filename $target_filename\n"
	expect_list 600 { "bytes sent" } { "Error" "Not connected" "No such" }
	expect_list 60 { "ftp> " } { "Not connected" "No such" }
	exp_send "quit\n"
	expect_any 60 { "221" "Goodbye" "So long" } { "ftp> " }
	if { $do_spawn } {
		wait_eof 60
	}
	set timeout $save_timeout
}

proc ftp_get_file { host usercode password target_filename local_filename {type "binary" } {do_spawn 1} } {
##
## ftp_get_file
## --------
## ftp a file from the target system to the local system
##
## Usage:
##	ftp_get_file host usercode password target_filename local_filename [type] [do_spawn]
## Arguments:
##	host - host to connect to
##	usercode - usercode on that host
##	password - password on that host
##	target_filename - file to get
##	local_filename - destination file on local system
##	type - type of file (ascii or binary).  Default is binary
##	do_spawn - should we spawn a expect session (eg. one not in progress already)

	global spawn_id
	global expect_out
	global spawn_out
	global timeout

	set save_timeout $timeout
	ftp_connect $host $usercode $password $do_spawn

	exp_send "$type\n"
	expect_list 60 { "ftp> " } { "Not connected" }

	exp_send "get $target_filename $local_filename\n"
	# allow for large files
	expect_list 600 { "bytes received" } { "Error" "Not connected" "No such" }
	expect_list 60 { "ftp> " } { "Not connected" "No such" }
	exp_send "quit\n"
	expect_any 60 { "221" "Goodbye" "So long" } { "ftp> " }
	if { $do_spawn } {
		wait_eof 60
	}
	set timeout $save_timeout
}

proc ftp_mget_files { host usercode password target_directory target_pattern local_directory {type "binary" } {do_spawn 1}} {
##
## ftp_mget_files
## --------
## ftp a set of files from the target system to the local system
##
## Usage:
##	ftp_mget_files host usercode password target_directory target_filename
##		local_directory [type] [do_spawn]
## Arguments:
##	host - host to connect to
##	usercode - usercode on that host
##	password - password on that host
##	target_directory - directory to get files from
##	target_pattern - files to get (can be wildcarded for target system)
##	local_directory - destination directory on local system
##	type - type of files (ascii or binary).  Default is binary
##	do_spawn - should we spawn a expect session (eg. one not in progress already)

	global spawn_id
	global expect_out
	global spawn_out
	global timeout

	set save_timeout $timeout
	ftp_connect $host $usercode $password $do_spawn

	exp_send "$type\n"
	expect_list 60 { "ftp> " } { "Not connected" }

	exp_send "cd $target_directory\n"
	expect_list 60 { "ftp> " } { "Not connected" }
	exp_send "lcd $local_directory\n"
	expect_list 60 { "ftp> " } { "Not connected" }
	exp_send "mget $target_pattern\n"
	# allow for large files
	expect_list 600 { "bytes received" } { "Error" "Not connected" "No such" }
	expect_list 60 { "ftp> " } { "Not connected" "No such" }
	exp_send "quit\n"
	expect_any 60 { "221" "Goodbye" "So long" } { "ftp> " }
	if { $do_spawn } {
		wait_eof 60
	}
	set timeout $save_timeout
}

proc date_stamp {} {
##
## datestamp
## ---------
##
## Usage:
## 	date_stamp
## Returns:
##	date in an identical format to the date command
## Additional Information:
##	should be used in preference to [exec date].  The performance
##      difference is 30 vs 175000 microseconds.
##
	return [timestamp -format "%a %b %d %X %Z %Y"]
}

proc tools_mult_timeout { mult } {
##
## tools_mult_timeout
## ------------
## adjust timeout multiplier by a factor of mult
##
## Usage:
##	tools_mult_timeout mult
## Arguments:
##	mult - multiply timeout multiplier by mult
## Returns:
##	None
## Additional Information:
##	updates the environment variable TEST_TIMEOUT_MULT

	global env
	set env(TEST_TIMEOUT_MULT) [ expr $mult * [ test_get_env TEST_TIMEOUT_MULT] ]
}

proc calc_timeout { timelimit } {
##
## calc_timeout
## ------------
## calculate the timeout value to use by adjusting by TEST_TIMEOUT_MULT
##
## Usage:
##	calc_timeout timelimit
## Arguments:
##	timelimit - a timeout value in seconds
## Returns:
##	timelimit adjusted by TEST_TIMEOUT_MULT
## Additional Information:
##	The environment variable TEST_TIMEOUT_MULT is used as an optional
##	multiplier for all timeout values.  This can be exported by the user
##	to adjust all the timeouts in a test to account for slow systems or
##	the use of debug tools such as printf or purify which significantly
##	affect the performance of the system.

	return [ expr $timelimit * [ test_get_env TEST_TIMEOUT_MULT] ]
}

proc set_timeout { timelimit } {
##
## set_timeout
## -----------
## set the expect timeout variable accounting for TEST_TIMEOUT_MULT
##
## Usage:
##	set_timeout timelimit
## Arguments:
##	timelimit - a timeout value in seconds
## Returns:
##	The timeout value set
## Additional Information:
##	The timeout variable in the callers stack frame is set.  It is up
##	to the caller to determine if this is the global or local version
##	of timeout.

	# sets the expect timeout variable in the stack frame of the caller
	return [ uplevel set timeout [ calc_timeout $timelimit ] ]
}

proc expect_list { timelimit list { error_list "" } { out_var "" } } {
##
## expect_list
## -----------
## apply expect sequencially against a list of messages
##
## Usage:
##	expect_list timelimit list [error_list [out_var]]
## Arguments:
##	timelimit - maximum wait for each message
##	list - list of messages to expect, they are regular expressions
##	error_list - optional list of messages, fails if any gotten,
##		regular expressions
##	out_var - variable in callers context to receive all text which was
##		received during during this expect
## Returns:
##	string in output which matched last regular expression in list
##	(this is also held in $expect_out(0,string) )
## Additional Information:
##	the expecting global is set as each item is expect'ed for such that
##	any errors are appropriately reported
##	an error is automatically reported if any of the error_list messages
##	are gotten at any point.  Avoid having an error_list message be
##	a subset or part of a valid list message
##	The global timeout is saved, changed and restored by this routine

    global spawn_id
    global expect_out
    global spawn_out
    global timeout
    global expecting
    global env

    set save_timeout $timeout

    set_timeout $timelimit

    if { "$out_var" != "" } {
	upvar $out_var out
	set out ""
    }
    # match against a 10 screen buffer
    match_max 19200 
    # expect is real picky about the quoting and braces here
    set fail_cmd {
	log_message "\nERROR: while waiting for: $expecting"
	log_message "\nERROR: Received data: $expect_out(buffer)"
	fail_test "Invalid data"
    }
    foreach item $list {
	set arg_list {}
	foreach err_item $error_list {
	    append arg_list " -re {$err_item} {
				log_message {\nERROR: invalid data: $err_item}
				$fail_cmd
				}"
	}
	append arg_list " -re {$item} noop"
	set expecting "$item"
	if { [ info exists env(TESTDEBUG) ] } {
	    log_message "DEBUG: spawn_id: $spawn_id expecting: $expecting"
	}
	eval expect "{
			$arg_list
		}"
	if { "$out_var" != "" } {
	    append out $expect_out(buffer)
	}
    }

    set timeout $save_timeout
    return $expect_out(0,string)
}

proc expect_any { timelimit list { error_list "" } { out_var ""} } {
##
## expect_any
## -----------
## apply expect once against a list of messages, succeed if matches any one
## message in list
##
## Usage:
##	expect_any timelimit list [error_list [out_var]]
## Arguments:
##	timelimit - maximum wait for each message
##	list - list of messages to expect, they are regular expressions
##	error_list - optional list of messages, fails if any gotten,
##		regular expressions
##	out_var - variable in callers context to receive all text which was
##		received during during this expect
## Returns:
##	string in output which matched a regular expression in list
##	(this is also held in $expect_out(0,string) )
## Additional Information:
##	accept 1st of list (eg. expects any 1 of list)
##	the expecting global is set such that
##	any errors are appropriately reported
##	an error is reported if any of the error_list messages
##	are gotten.  Avoid having an error_list message be
##	a subset or part of a valid list message
##	The global timeout is saved, changed and restored by this routine

	global spawn_id
	global expect_out
	global spawn_out
	global timeout
	global expecting
	global env

	set save_timeout $timeout

	set_timeout $timelimit

	if { "$out_var" != "" } {
		upvar $out_var out
		set out ""
	}
	# expect is real picky about the quoting and braces here
	set fail_cmd {
		log_message "\nERROR: while waiting for: $expecting"
		log_message "\nERROR: Received data: $expect_out(buffer)"
		fail_test "Invalid data"
	}
	set expecting ""
	set arg_list {}
	foreach err_item $error_list {
		append arg_list " -re {$err_item} {
			log_message {\nERROR: invalid data: $err_item}
			$fail_cmd
			}"
	}
	foreach item $list {
		append arg_list " -re {$item} noop"
		if { "$expecting" == "" } {
			set expecting "$item"
		} else {
			set expecting "$expecting OR $item"
		}
	}
	if { [ info exists env(TESTDEBUG) ] } {
		log_message "DEBUG: spawn_id: $spawn_id expecting: $expecting"
	}
	eval expect "{
		 $arg_list
	}"
	if { "$out_var" != "" } {
		append out $expect_out(buffer)
	}

	set timeout $save_timeout
	return $expect_out(0,string)
}

proc expect_progress { timelimit progress_list done_list { error_list "" } { out_var "" } } {
##
## expect_progress
## -----------
## apply expect against a long running operation which reflects progress
##
## Usage:
##	expect_progress timelimit progress_list done_list [error_list [out_var]]
## Arguments:
##	timelimit - maximum wait for each message
##	progress_list - list of progress messages to expect,
##		they are regular expressions
##	done_list - list of completion messages to expect,
##		they are regular expressions
##	error_list - optional list of messages, fails if any gotten,
##		regular expressions
##	out_var - variable in callers context to receive all text which was
##		received during during this expect
## Returns:
##	string in output which matched a regular expression in done_list
##	(this is also held in $expect_out(0,string) )
## Additional Information:
##	expects to see at least one progress_list or done_list message
##	within each timelimit interval.
##	progress_list messages reset timelimit and expect is run again
##	progress_list messages can be repeated or seen in any order.
##	There is no requirement for any nor all of them to occur.
##	done_list messages indicate completion and all must appear in the order
##	given.
##	the expecting global is set as each done item is expect'ed for such that
##	any errors are appropriately reported
##	an error is automatically reported if any of the error_list messages
##	are gotten at any point.  Avoid having an error_list message be
##	a subset or part of a valid list message
##	The global timeout is saved, changed and restored by this routine

    global spawn_id
    global expect_out
    global spawn_out
    global timeout
    global expecting
    global env

    set save_timeout $timeout

    set_timeout $timelimit

    if { "$out_var" != "" } {
	upvar $out_var out
	set out ""
    }
    # expect is real picky about the quoting and braces here
    set fail_cmd {
	log_message "\nERROR: while waiting for: $expecting"
	log_message "\nERROR: Received data: $expect_out(buffer)"
	fail_test "Invalid data"
    }
    foreach item $done_list {
	set arg_list {}
	foreach err_item $error_list {
	    append arg_list " -re {$err_item} {
				log_message {\nERROR: invalid data: $err_item}
				$fail_cmd
				}"
	}
	append arg_list " -re {$item} noop"
	set expecting "$item"
	foreach prog_item $progress_list {
	    append arg_list " -re {$prog_item}"
	    append arg_list { {
		if { "$out_var" != "" } {
		    append out $expect_out(buffer)
		}
		exp_continue } }
	    append expecting " OR $prog_item"
	}
	if { [ info exists env(TESTDEBUG) ] } {
	    log_message "DEBUG: spawn_id: $spawn_id expecting: $expecting"
	}
	eval expect "{
			 $arg_list
		}"
	if { "$out_var" != "" } {
	    append out $expect_out(buffer)
	}
    }

    set timeout $save_timeout
    return $expect_out(0,string)
}

proc _got_orderless_item { got once listname error_listname indexname } {
#
# _got_orderless_item
# -------------------
# Process a matched item
#
# Usage:
# _got_orderless_item got once listname error_listname indexname
#
# Arguments:
#	got - pattern matched within the list
#	once - should got be added to error_list (1=yes, 0=no)
#	listname - name of list variable which contains $got
#	error_listname - name of error_list variable to update
#	indexname - name of variable to hold index of got within list
# Additional Information:
#	list is updated to remove got from it
#	if once, got is appended to error_list
#	fatal error if got not found in list
#	list is a list of string match, expect style patterns

	upvar $listname list
	upvar $error_listname error_list
	upvar $indexname index

	set index [ lsearch -exact $list $got ]
	if { $index == -1 } {
		fail_test "Bug in expect_list_orderless: got={$got}, list={$list}"
	}
	set list [ lreplace $list $index $index ]
	if { $once } {
		lappend error_list "$got"
	}
}

proc expect_list_orderless { timelimit once list { error_list "" } { out_var ""} } {
##
## expect_list_orderless
## -----------
## apply expect against a list of messages, order independently
##
## Usage:
##	expect_list_orderless timelimit once list [error_list [out_var]]
## Arguments:
##	timelimit - maximum time to wait for next message
##	once - if 1, it is an error for any of the messages in list to
##		occur more than once, if 0 they can occur any number of
##		times
##	list - list of messages to expect, regular expressions
##	error_list - optional list of messages, fails if any gotten,
##		regular expressions
##	out_var - variable in callers context to receive all text which was
##		received during during this expect
## Returns:
##	string in output which last matched a regular expression in list
##	(this is also held in $expect_out(0,string) )
## Additional Information:
##	the expecting global is set as each item set is expect'ed for such that
##	any errors are appropriately reported
##	an error is automatically reported if any of the error_list messages
##	are gotten at any point.  Avoid having an error_list message be
##	a subset or part of a valid list message
##	list messages should not be subsets of eachother
##	The messages in list are permitted to occur in any order.
##	If you want to permit a given message to occur more than once,
##	set once=0
##	The global timeout is saved, changed and restored by this routine

	global spawn_id
	global expect_out
	global spawn_out
	global timeout
	global expecting
	global env

	set save_timeout $timeout

	set_timeout $timelimit

	if { "$out_var" != "" } {
		upvar $out_var out
		set out ""
	}
	# expect is real picky about the quoting and braces here
	set fail_cmd {
		log_message "\nERROR: while waiting for: $expecting"
		log_message "\nERROR: Received data: $expect_out(buffer)"
		fail_test "Invalid data"
	}
	while { [ llength $list ] != 0 } {
		# build arg_list with the list of valid items
		# expecting indicates all the items remaining
		set expecting ""
		set arg_list {}
		foreach err_item $error_list {
			append arg_list " -re {$err_item} {
				log_message {\nERROR: invalid data: $err_item}
				$fail_cmd
				}"
		}
		foreach item $list {
			append arg_list " -re {$item} { set got {$item} }"
			if { "$expecting" == "" } {
				set expecting "$item"
			} else {
				set expecting "$expecting OR $item"
			}
		}
		set got ""
		if { [ info exists env(TESTDEBUG) ] } {
			log_message "DEBUG: expecting $expecting"
		}
		eval expect "{
		 	$arg_list
		}"
		if { "$out_var" != "" } {
			append out $expect_out(buffer)
		}
		# if we did not fail_test by getting an invalid item,
		# got will indicate what we did get
		# Remove that item from the list of valid messages and
		# if once, add it to the list of invalid message
		if { "$got" != "" } {
			_got_orderless_item $got $once list error_list index
			# expect will take a single output buffer and
			# apply the patterns in the order given, in the event
			# of a large output or multiple patterns which should
			# be matched by a single line, expect may match fewer
			# patterns than are possible to be matched
			# now see if other patterns in the remainder of
			# the list are also matched
			foreach item [ lrange $list $index end ] {
				if { [ regexp ".*$item.*" $expect_out(buffer) ] == 1 } {
					_got_orderless_item $item $once list error_list index
				}
			}
		} else {
			fail_test "Bug in expect_list_orderless, got={}"
		}
	}

	set timeout $save_timeout
	return $expect_out(0,string)
}

proc expect_progress_orderless { timelimit progress_list once done_list { error_list "" } { out_var ""} } {
##
## expect_progress_orderless
## -----------
## apply expect against a long running operation which reflects progress
## and expect a list of messages, order independently
##
## Usage:
##	expect_progress_orderless timelimit progress_list once done_list [error_list [out_var]]
## Arguments:
##	timelimit - maximum time to wait for next message
##	progress_list - list of progress messages to expect,
##		they are regular expressions
##	once - if 1, it is an error for any of the messages in list to
##		occur more than once, if 0 they can occur any number of
##		times
##	done_list - list of completion messages to expect, regular expressions
##	error_list - optional list of messages, fails if any gotten,
##		regular expressions
##	out_var - variable in callers context to receive all text which was
##		received during during this expect
## Returns:
##	string in output which last matched a regular expression in done_list
##	(this is also held in $expect_out(0,string) )
## Additional Information:
##	expects to see at least one progress_list or done_list message
##	within each timelimit interval.
##	progress_list messages reset timelimit and expect is run again
##	progress_list messages can be repeated or seen in any order.
##	There is no requirement for any nor all of them to occur.
##	the expecting global is set as each item set is expect'ed for such that
##	any errors are appropriately reported
##	an error is automatically reported if any of the error_list messages
##	are gotten at any point.  Avoid having an error_list message be
##	a subset or part of a valid list message
##	done_list messages should not be subsets of eachother
##	The messages in done_list are permitted to occur in any order.
##	If you want to permit a given message to occur more than once,
##	set once=0
##	The global timeout is saved, changed and restored by this routine

	global spawn_id
	global expect_out
	global spawn_out
	global timeout
	global expecting
	global env

	set save_timeout $timeout

	set_timeout $timelimit

	if { "$out_var" != "" } {
		upvar $out_var out
		set out ""
	}
	# expect is real picky about the quoting and braces here
	set fail_cmd {
		log_message "\nERROR: while waiting for: $expecting"
		log_message "\nERROR: Received data: $expect_out(buffer)"
		fail_test "Invalid data"
	}
	while { [ llength $done_list ] != 0 } {
		# build arg_list with the list of valid items
		# expecting indicates all the items remaining
		set expecting ""
		set arg_list {}
		foreach err_item $error_list {
			append arg_list " -re {$err_item} {
				log_message {\nERROR: invalid data: $err_item}
				$fail_cmd
				}"
		}
		foreach item $done_list {
			append arg_list " -re {$item} { set got {$item} }"
			if { "$expecting" == "" } {
				set expecting "$item"
			} else {
				set expecting "$expecting OR $item"
			}
		}
		foreach prog_item $progress_list {
	    	append arg_list " -re {$prog_item}"
	    	append arg_list { {
			if { "$out_var" != "" } {
		    	append out $expect_out(buffer)
			}
			exp_continue } }
	    	append expecting " OR $prog_item"
		}
		set got ""
		if { [ info exists env(TESTDEBUG) ] } {
	    	log_message "DEBUG: spawn_id: $spawn_id expecting: $expecting"
		}
		eval expect "{
		 	$arg_list
		}"
		if { "$out_var" != "" } {
			append out $expect_out(buffer)
		}
		# if we did not fail_test by getting an invalid item,
		# got will indicate what we did get
		# Remove that item from the list of valid messages and
		# if once, add it to the list of invalid message
		if { "$got" != "" } {
			_got_orderless_item $got $once done_list error_list index
			# expect will take a single output buffer and
			# apply the patterns in the order given, in the event
			# of a large output or multiple patterns which should
			# be matched by a single line, expect may match fewer
			# patterns than are possible to be matched
			# now see if other patterns in the remainder of
			# the list are also matched
			foreach item [ lrange $done_list $index end ] {
				if { [ regexp ".*$item.*" $expect_out(buffer) ] == 1 } {
					_got_orderless_item $item $once done_list error_list index
				}
			}
		} else {
			fail_test "Bug in expect_list_orderless, got={}"
		}
	}

	set timeout $save_timeout
	return $expect_out(0,string)
}

proc test_execute {list code} {
##
## test_execute
## ------------
## Conditionally execute the block of code specified
##
## Usage:
##	test_execute { list } {
##		conditional code
##	}
## Arguments:
##	list - a list of conditions under which the code should not be run.  The
##		items specified in the list are searched for in the
##		TEST_NOEXECUTE environment variable and if found, the code is
##		not executed.
##	code = Tcl commands for execution (typically a list)
## Returns:
##	None
## Additional Information:
##	This routine will not execute any code if any of the items in the list
##	are located in the TEST_NOEXECUTE environment variable list.
##	Further, the code is not executed if the TEST_IDENTIFY environment
##	variable is defined.
##
    global env

    if { ! [ identify_mode ] } {
	set skip 0
	if { [ info exists env(TEST_NOEXECUTE) ] } {
	    foreach item $list {
		if { [lsearch -exact "$env(TEST_NOEXECUTE)" $item ] != -1 } {
		    set skip 1;
		    break;
		}
	    }
	}
	if { $skip == 0 } {
	    uplevel $code
	}
    }
}

proc show_config {} {
##
## show_config
## -------------
## determine if tests are being run with show config enabled
##
## Usage:
##	show_config
## Returns:
##	0 - no
##	1 - yes

	return [ test_check_yn [ test_get_env TEST_SHOW_CONFIG ] ]
}

proc show_start {} {
##
## show_start
## -------------
## determine if tests are being run with show start enabled
##
## Usage:
##	show_start
## Returns:
##	0 - no
##	1 - yes

	return [ test_check_yn [ test_get_env TEST_SHOW_START ] ]
}

proc identify_mode {} {
##
## identify_mode
## -------------
## determine if tests are being run in identify mode
##
## Usage:
##	identify_mode
## Returns:
##	0 - no
##	1 - yes

	return [ test_check_yn [ test_get_env TEST_IDENTIFY ] ]
}

proc get_config_path { filename } {
##
## get_config_path
## -----------
## Return the path to the configuration file specified
##
## Arguments:
##	filename - name of a configuration file
## Additional Information:

	global env

	if { ( ! [ file exists $filename ] || [ file isdirectory $filename ] )
		 && [ info exists env(TL_DIR) ] } {
		set dir1 "$env(TL_DIR)/configs"
		set dir2 "$env(TL_DIR)/HostTestCases/configs"
		if { [ file isdirectory "$dir1" ]
			&& [ file exists "$dir1/$filename" ] } {
			return "$dir1/$filename"
		} elseif { [ file isdirectory "$dir2" ]
			&& [ file exists "$dir2/$filename" ] } {
			return "$dir2/$filename"
		} else {
			set res "get_config_path: unable to find $filename in ., $dir1 nor $dir2"
			log_message "$res"
			error "$res"
		}
	} elseif { [ file exists $filename ] } {
		return "$filename"
	}
}

proc read_config { filename } {
##
## read_config
## -----------
## Read the configuration file specified
##
## Arguments:
##	filename - name of a configuration file
## Additional Information:
##	The configuration file consists of lines of the form:
##		parameter_name	value
##				OR
##		include filename
##	If the "parameter_name" is # or the line is blank,
##	the given line is ignored
##	Otherwise the parameter is set to the supplied value unless
##	it is already exported.  This allows the configuration to
##	be partially overridden by the environment.  It also permits the
##	setting of any environment variables (such as TEST_FAIL_SAVE)
##	An omitted "value" field results in the parameter being set to the
##	null string
##	If parameter_name is already exported, it overrides the value in the
##	config file.  Due to use of eval, value for a parameter can include
##	references to other parameters and environment variables as $env(name)

	global env

	if { [ show_config ] } {
		show_message "Test Configuration File: $filename"
	}
	set filename [get_config_path $filename ]
	set fileid [ open $filename "r" ]
	if { [ catch {
		while { [ gets $fileid line ] != -1 } {
			set parameter [ lindex $line 0 ]
			if { "$parameter" == ""
			     || "[ string index $parameter 0 ]" == "#" } {
				# comment or blank line
				continue
			}
			eval set value \[ lreplace \"$line\" 0 0 \]
			#set value [ lreplace $line 0 0 ]
			if { "$parameter" == "include" } {
				read_config "$value"
			} else {
				if { ! [ info exists env($parameter) ] } {
					set env($parameter) "$value"
					#eval set env($parameter) \"$value\"
				}
				# show the parameter values
				set message [ format "%-25s %s" $parameter $env($parameter) ]
				if { [ show_config ] } {
					show_message "$message"
				}
			}
		}
		if { [ show_config ] } {
			show_message ""
		}
		close $fileid
	} res ] != 0 } {
		catch { close $fileid }
		if { [ show_config ] } {
			show_message ""
		}
		log_message "read_config: $res in variable \"$parameter\""
		error "read_config: $res in variable \"$parameter\""
	}

	# fixup suffixes, this is a hack, should be put elsewhere
	if { [ info exists env(CFG_IPOIB_SUFFX) ]
		 && [ string equal "$env(CFG_IPOIB_SUFFIX)" "NONE" ] } {
		set env(CFG_IPOIB_SUFFIX) ""
	}
	if { [ info exists env(CFG_IPOIB_PREFIX) ]
		 && [ string equal "$env(CFG_IPOIB_PREFIX)" "NONE" ] } {
		set env(CFG_IPOIB_PREFIX) ""
	}
	if { [ info exists env(CFG_INIC_SUFFX) ]
		 && [ string equal "$env(CFG_INIC_SUFFIX)" "NONE" ] } {
		set env(CFG_INIC_SUFFIX) ""
	}
}

proc get_config { var } {
##
## get_config
## -------------
## support function for use by front.sh to get config file values
## out to a calling bash shell

	#global env

	#puts "$env($var)"
	puts [test_get_env "$var"]
}

proc sum_list { list } {
##
## sum_list
## -------------
## compute the sum of a list of numbers
##
## Usage:
##	sum_list list
## Arguments:
##	list - a list of numbers
## Returns:
##	sum
## Additional Information:
##	non-numeric entries in the list are quietly ignored

	set sum 0
	foreach entry $list {
		if { [ string is double $entry ] } {
			incr sum $entry
		}
	}
	return $sum
}

proc tools_get_platform {} {
    global tcl_platform
    return $tcl_platform(machine)
}

# IPtoHex assumes IP has already been validated
proc IPtoHex { IP } {
    binary scan [binary format c4 [split $IP .]] H8 Hex
    return $Hex
}

proc hexToIP { Hex } {
    binary scan [binary format H8 $Hex] c4 IPtmp
    foreach num $IPtmp {
    # binary scan "c" format gives signed int - the following
    # [expr]-ology converts to unsigned (from [binary] manpage)
        lappend IP [expr ($num + 0x100) % 0x100]
    }
    set IP [join $IP .]
    return $IP
}

# IP and netmask in Hex, returns hex
proc broadcastAddress { hexIP hexNetmask } {
    set tmpBrdAddr [expr 0x$hexIP | ( 0x$hexNetmask ^ 0xffffffff )]
    binary scan [binary format I $tmpBrdAddr] H8 broadcastAddress
    return $broadcastAddress
}

# IP and netmask in Hex, returns hex
proc networkAddress { hexIP hexNetmask } {
    set compNetmask [expr 0x$hexNetmask ^ 0xffffffff]
    set tmpNetAddr [expr ( 0x$hexIP | $compNetmask ) ^ $compNetmask]
    binary scan [binary format I $tmpNetAddr] H8 networkAddress
    return $networkAddress
}

proc IPisValid { IP } {
    # must contain only dots and digits
    # this originally read:-
    #if { [regsub -all {[.0-9]} $IP {}] != "" } {
    #  return 0
    #}
    regsub -all {[.0-9]} $IP {} tmpStr
    if { $tmpStr != "" } {
        return 0
    }
    # however this appears to be a 8.4.1-ism which doesn't work with
    # earlier versions (e.g. the 8.4a2 version that the PocketPC tcltk
    # version is based on.
    #
    # exactly three dots
    regsub -all {[0-9]} $IP {} tmpStr
    if { $tmpStr != "..." } {
        return 0
    }
    # each numerical component is between 0 and 255
    foreach b [split $IP .] {
        if { [string length $b] == 0 } {
            return 0
        }
        set ob $b
        scan $b %d b ;# allow for leading zeros which tcl thinks are octal
        if { $b < 0 | $b > 255 } {
           return 0
        }
    }
    return 1
}


proc getBroadCast { ip netmask } {
##
## getBroadCast
## -----------
## Return the broadcast address given IP and netmask
##
## Usage:
##  getBroadCast ip netmask
## Arguments:
##  ip - valid IP address. can be a network address.
##  netmask - the netmask for this IP.
## Returns
##  netmask in the form nnn.nnn.nnn.nnn
##
    if { ! [IPisValid $ip] } {
        error "IP is not valid"
    }
    if { ! [IPisValid $netmask] } {
        error "Netmask is not valid"
    }
    set hexIP [IPtoHex $ip]
    set hexNM [IPtoHex $netmask]
    set hexBC [broadcastAddress $hexIP $hexNM]
    set broadcastAddress [hexToIP $hexBC]
    return $broadcastAddress
}

proc getNetWork { ip netmask } {
##
## getNetWork
## -----------
## Return the netowkr address given IP and netmask
##
## Usage:
##  getNwtWork ip netmask
## Arguments:
##  ip - valid IP address. can be a network address.
##  netmask - the netmask for this IP.
## Returns
##  network in the form nnn.nnn.nnn.nnn
##
    if { ! [IPisValid $ip] } {
        error "IP is not valid"
    }
    if { ! [IPisValid $netmask] } {
        error "Netmask is not valid"
    }
    set hexIP [IPtoHex $ip]
    set hexNM [IPtoHex $netmask]
    set hexNW [networkAddress $hexIP $hexNM]
    set networkAddress [hexToIP $hexNW]
    return $networkAddress
}