#!/usr/bin/env expect
############################################################################
# Purpose: Establish global state information for Slurm test suite
#
# To define site-specific state information, set the values in a file
# named 'globals.local'. Those values will override any specified here.
# for example:
#
# $ cat globals.local
# set slurm_dir  "/usr/local"
# set build_dir  "/home/mine/SLURM/build_smd"
# set src_dir    "/home/mine/SLURM/slurm.git"
# set mpicc      "/usr/local/bin/mpicc"
#
# If you want to have more than one test going at the same time for multiple
# installs you can have multiple globals.local files and set the
# SLURM_LOCAL_GLOBALS_FILE env var, and have that set to the correct
# globals.local file for your various installs.  The file can be named anything,
# not just globals.local.
#
############################################################################
# Copyright (C) 2002-2007 The Regents of the University of California.
# Copyright (C) 2008-2010 Lawrence Livermore National Security.
# Copyright (C) SchedMD LLC.
# Produced at Lawrence Livermore National Laboratory (cf, DISCLAIMER).
# Written by Morris Jette <jette1@llnl.gov>
# Additions by Joseph Donaghy <donaghy1@llnl.gov>
# CODE-OCEC-09-009. All rights reserved.
#
# This file is part of Slurm, a resource management program.
# For details, see <https://slurm.schedmd.com/>.
# Please also read the supplied file: DISCLAIMER.
#
# Slurm is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 2 of the License, or (at your option)
# any later version.
#
# Slurm is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Slurm; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA.
############################################################################

# Avoid sourcing this file multiple times
if {[info procs exit] eq "exit"} {
	return
}

# Read in unified testsuite properties from testsuite/testsuite.conf
set unified_testsuite_dir [file dirname [file normalize "[info script]/.."]]
set unified_testsuite_conf_file "$unified_testsuite_dir/testsuite.conf"
if {[info exists env(SLURM_TESTSUITE_CONF)]} {
	set unified_testsuite_conf_file $env(SLURM_TESTSUITE_CONF)
}
set unified_testsuite_config_dict [dict create]
if [file readable "$unified_testsuite_conf_file"] {
	set fp [open "$unified_testsuite_conf_file" r]
	set file_data [read $fp]
	close $fp
	foreach line [split $file_data "\n"] {
		if [regexp {^\s*(\S+)\s*=\s*(\S+)\s*$} $line {} parameter_name parameter_value] {
			dict set unified_testsuite_config_dict [string tolower $parameter_name] $parameter_value
		}
	}
} else {
	puts stderr "Warning: Unable to open the unified testsuite configuration file ($unified_testsuite_conf_file) for reading. This file can be created from a copy of the autogenerated sample found in BUILDDIR/testsuite/testsuite.conf.sample. By default, this file is expected to be found in SRCDIR/testsuite ($unified_testsuite_dir). If placed elsewhere, set the SLURM_TESTSUITE_CONF environment variable to the full path of your testsuite.conf file."
	flush stderr
}
if [dict exists $unified_testsuite_config_dict "slurmsourcedir"] {
	set src_dir [dict get $unified_testsuite_config_dict "slurmsourcedir"]
}
if [dict exists $unified_testsuite_config_dict "slurmbuilddir"] {
	set build_dir [dict get $unified_testsuite_config_dict "slurmbuilddir"]
}
if [dict exists $unified_testsuite_config_dict "slurminstalldir"] {
	set slurm_dir [dict get $unified_testsuite_config_dict "slurminstalldir"]
}

global sacctmgr sacct salloc sattach sbatch sbcast scancel scontrol sinfo
global smd squeue sreport srun sstat strigger

################################################################
#
# NAME
#	cset - conditional set
#
# SYNOPSIS
#	cset name value
#
# DESCRIPTION
#	Conditional set.  Only set variable if variable does not yet exist.
#
# Input: name  -- name of the variable to set
#	 value -- value to set to 'name'
#
################################################################

proc cset {name value} {
	if {![uplevel 1 info exists $name]} {
		upvar $name tmp
		set tmp $value
	}
}


#
# Defining colors here to be able to use them in globals.local.
# By default, these colors are bold
#
set COLOR_RED         "\033\[1;31m"
set COLOR_RED_NORMAL  "\033\[31m"
set COLOR_ORANGE      "\033\[1;38;5;208m"
set COLOR_YELLOW      "\033\[1;33m"
set COLOR_GREEN       "\033\[1;32m"
set COLOR_BLUE        "\033\[1;34m"
set COLOR_MAGENTA     "\033\[1;35m"
set COLOR_CYAN        "\033\[1;36m"
set COLOR_NONE        "\033\[0m"

cset local_globals_file "./globals.local"

# Log level "enum"
# Define log levels here so they are available in globals.local
set LOG_LEVEL_QUIET   0
set LOG_LEVEL_FATAL   1
set LOG_LEVEL_ERROR   2
set LOG_LEVEL_WARNING 3
set LOG_LEVEL_INFO    4
set LOG_LEVEL_PASS    4
set LOG_LEVEL_COMMAND 4
set LOG_LEVEL_DEBUG   5
set LOG_LEVEL_TRACE   6

if {[info exists env(SLURM_LOCAL_GLOBALS_FILE)]} {
	set local_globals_file $env(SLURM_LOCAL_GLOBALS_FILE)
}

if [file exists $local_globals_file] {
	source $local_globals_file
}

#
# Specify the slurm install directory.
# Used to locate binaries, libraries, and header files.
#
cset slurm_dir   "/usr"
cset build_dir   "../../"
cset src_dir     "../../"
cset config_h    "${build_dir}/config.h"
cset sacctmgr    "${slurm_dir}/bin/sacctmgr"
cset sacct       "${slurm_dir}/bin/sacct"
cset salloc      "${slurm_dir}/bin/salloc"
cset sattach     "${slurm_dir}/bin/sattach"
cset sbatch      "${slurm_dir}/bin/sbatch"
cset sbcast      "${slurm_dir}/bin/sbcast"
cset scancel     "${slurm_dir}/bin/scancel"
cset scontrol    "${slurm_dir}/bin/scontrol"
cset sdiag       "${slurm_dir}/bin/sdiag"
cset sgather     "${slurm_dir}/bin/sgather"
cset sh5util     "${slurm_dir}/bin/sh5util"
cset sinfo       "${slurm_dir}/bin/sinfo"
cset smd         "${slurm_dir}/bin/smd"
cset sprio       "${slurm_dir}/bin/sprio"
cset squeue      "${slurm_dir}/bin/squeue"
cset srun        "${slurm_dir}/bin/srun"
cset sreport     "${slurm_dir}/bin/sreport"
cset sshare      "${slurm_dir}/bin/sshare"
cset sstat       "${slurm_dir}/bin/sstat"
cset strigger    "${slurm_dir}/bin/strigger"

cset slurmd      "${slurm_dir}/sbin/slurmd"
cset slurmrestd  "${slurm_dir}/sbin/slurmrestd"

cset pbsnodes    "${slurm_dir}/bin/pbsnodes"
cset qdel        "${slurm_dir}/bin/qdel"
cset qstat       "${slurm_dir}/bin/qstat"
cset qsub        "${slurm_dir}/bin/qsub"
cset qalter      "${slurm_dir}/bin/qalter"
cset qrerun      "${slurm_dir}/bin/qrerun"

cset seff        "${slurm_dir}/bin/seff"

cset lsid      	 "${slurm_dir}/bin/lsid"
cset bjobs     	 "${slurm_dir}/bin/bjobs"
cset bkill     	 "${slurm_dir}/bin/bkill"
cset bsub     	 "${slurm_dir}/bin/bsub"

cset influx	"/usr/bin/influx"
# If using MPICH-2 or other version of MPI requiring pmi libary, use this
#cset mpicc	"/home/jette/mpich2-install/bin/mpicc"
#cset use_pmi	1
# OR for other versions of MPICH, use this
cset mpicc	"/usr/local/bin/mpicc"
cset nvcc	"/usr/bin/nvcc"
cset use_pmi	0
#cset upcc       "/usr/local/bin/upcc"
cset upcc       "/usr/bin/xlupc"
cset oshcc      "/usr/local/bin/oshcc"

cset mpirun	"mpirun"
cset totalviewcli	"/usr/local/bin/totalviewcli"

# Set if using "--enable-memory-leak-debug" configuration option
cset enable_memory_leak_debug 0

# test_prompt: to be used as prompt for interactive shells (see proc reset_bash_prompt)
set test_prompt  "TEST_PROMPT: "

#
# Specify locations of other executable files used
# Only the shell names (e.g. bin_bash) must be full pathnames
#
cset bin_awk	"awk"
cset bin_bash   [exec which bash | tail -n 1]
cset bin_cat	"cat"
cset bin_cc	"gcc"
cset bin_chmod	"chmod"
cset bin_cmp	"cmp"
cset bin_cp	"cp"
cset bin_date	"date"
cset bin_diff	"diff"
cset bin_echo	"echo"
cset bin_env	"env"
cset bin_file	"file"
cset bin_id	"id"
cset bin_ip	"ip"
cset bin_jq	"jq"
cset bin_grep   "grep"
cset bin_head   "head"
cset bin_ln     "ln"
cset bin_perldoc "/usr/bin/perldoc"
cset bin_py3     "python3"
cset bin_oasgen  "openapi-generator-cli"

# Don't user $bin_hostname, use $bin_printenv SLURMD_NODENAME
cset bin_hostname "hostname"

cset bin_kill	"kill"
cset bin_lscpu	"lscpu"
cset bin_make	"make"
cset bin_mv	"mv"
cset bin_od	"od"
cset bin_pkill	"pkill"
cset bin_printenv "printenv"
cset bin_ps	"ps"
cset bin_pwd	"pwd"
cset bin_rm	"rm"
cset bin_sed	"sed"
cset bin_sleep  "sleep"
cset bin_sort	"sort"
cset bin_socat	"socat"
cset bin_sum	"sum"
cset bin_sudo	"sudo"
cset bin_systemd_detect_virt "systemd-detect-virt"
cset bin_touch	"touch"
cset bin_true	"true"
cset bin_uname	"uname"
cset bin_uniq	"uniq"
cset bin_unshare "unshare"
cset bin_virtualenv "virtualenv"
cset bin_wc	"wc"

#
# Let the commands complete without expect timing out waiting for a
# response. Single node jobs submitted to the default partition should
# be initiated within this number of seconds.
# for interactive slurm jobs: cset timeout $max_job_delay
#
cset max_job_delay 120

#
# Specify the maximum number of tasks to use in the stress tests.
#
cset max_stress_tasks 4

#
# The error message that the "sleep" command prints when we run "sleep aaa".
#
cset sleep_error_message "(invalid time interval)|(bad character in argument)|(usage: sleep seconds)"

# Force LANG, as the expect tests aren't localized
set ::env(LANG)          "en_US.UTF-8"

# Testsuite level variables
cset testsuite_dir "[file dirname [file normalize [info script]]]"
cset testsuite_shared_dir "[$bin_pwd]"

# Testsuite non-privileged user (set it in globals.local)
cset testsuite_user ""

# Testsuite log variables
cset testsuite_log_level $LOG_LEVEL_DEBUG
cset testsuite_log_format "\[%{timestamp}s.%{msecs}03d] %{loglevel}-7s %{message}s \(%{backtrace}s)"
cset testsuite_time_format "%Y-%m-%d %H:%M:%S"

# Default to using color if writing to a terminal and not if writing to a file
cset testsuite_colorize        [dict exists [fconfigure stdout] -mode]
cset testsuite_color_fatal     $COLOR_RED
cset testsuite_color_error     $COLOR_RED_NORMAL
cset testsuite_color_warn      $COLOR_ORANGE
cset testsuite_color_info      $COLOR_YELLOW
cset testsuite_color_pass      $COLOR_GREEN
cset testsuite_color_command   $COLOR_CYAN
cset testsuite_color_debug     $COLOR_BLUE
cset testsuite_color_trace     $COLOR_MAGENTA
cset testsuite_color_header    $COLOR_NONE
cset testsuite_color_success   $COLOR_GREEN
cset testsuite_color_failure   $COLOR_RED
cset testsuite_color_skipped   $COLOR_ORANGE

# Set to true to cause the first subtest failure to immediately end the test
cset testsuite_subtest_fatal   false
# Set to all, fail_skip, fail or none print datails of subtests and testprocs
cset testsuite_subtest_details  fail
cset testsuite_testproc_details fail
cset testsuite_testproc_log_calls ignore_skips

# To automatically call cleanup or not when ending the test
cset testsuite_cleanup_on_failure true
if {[info exists env(SLURM_TESTSUITE_CLEANUP_ON_FAILURE)]} {
	set testsuite_cleanup_on_failure $env(SLURM_TESTSUITE_CLEANUP_ON_FAILURE)
}

# To avoid potential infinite loops due calls to fail/pass/skip inside
# custom cleanup procs (_test_fini should be called only once)
set _test_fini_called false

# Testproc internal variables
set _testproc_included    [list]
set _testproc_excluded    [list]
set _testproc_pass_list   [list]
set _testproc_skip_list   [list]
set _testproc_fail_list   [list]
set _testproc_messages    [dict create]
set _testproc_skip_next   false
set _testproc_skip_reason ""
set _incomplete_reason    ""
set _subtest_messages     [dict create]

set _subtest_pass_count   0
set _subtest_skip_count   0
set _subtest_fail_count   0

set STATUS_PASS 0
set STATUS_FAIL 1
set STATUS_SKIP -1

# Final test status
set test_status $STATUS_PASS

# Other common variables
set re_word_str          "\\S+"
set digit                "\\d"
set eol                  "\r?\n"
set float                "\\d+\\.?\\d*"
set number               "\\d+"
set format_time          "\\d+\\:\\d+\\:\\d+"
set number_with_suffix   "\\d+\[KM\]*"
set slash                "/"
set whitespace		 "\\s+"
set controlmachine_regex "\\S+"
# Any characters except ( , : newline
set no_delim             "\[^(,:\r\n\]"
set no_delim_slash       "\[^(,:/\r\n\]"
# The first group matches GRES name
# The second **optional** group matches GRES type.
# The third group matches GRES count.
# Test out the regex here: https://regex101.com/r/FlNYKM/7
set gres_regex "($no_delim_slash*):($no_delim*)?:?($no_delim*)?:?($no_delim*)"

#basic #defines in slurm.h
set NO_VAL 0xfffffffe
set INFINITE 0xffffffff
set SLURM_MAX_NORMAL_STEP_ID 0xfffffff0
set SLURM_EXTERN_CONT 0xfffffffc
set SLURM_BATCH_SCRIPT 0xfffffffb


#
# Global variable used in multiple functions in "globals" file
#
set gpu_sock_list {}

#
# Procedure return values
#
set RETURN_SUCCESS 0
set RETURN_ERROR   1
set RETURN_TIMEOUT 110 ; # ETIMEDOUT


################################################################
#
# NAME
#	fail - fails a test
#
# SYNOPSIS
#	fail message
#
# DESCRIPTION
#	To be used when an error is fatal for the test. This routine
#	prints the specified error message, optionally cleans up, prints
#	a final test failure message, and exits the test with exit code 1.
#
# ENVIRONMENT
#	Whether or not the cleanup procedure is called depends on the setting
#	of the $testsuite_cleanup_on_failure set in the globals.local file or
#	overridden with the SLURM_TESTSUITE_CLEANUP_ON_FAILURE environment
#	variable.
#
# NOTE
#	DO NOT call this within your local cleanup procedure.
#
################################################################

proc fail { message } {
	global _incomplete_reason STATUS_FAIL

	# Avoid recursive calls from within cleanup
	if {[info level] > 1 && [lindex [info level -1] 0] eq "cleanup"} {
		log_error "Local cleanup shouldn't call pass, fail or skip"
		return
	}

	log_fatal $message
	set _incomplete_reason $message

	# _test_fini will handle cleanup and print the failure message.
	_test_fini $STATUS_FAIL
}


################################################################
#
# NAME
#	skip - skips a test
#
# SYNOPSIS
#	skip message
#
# DESCRIPTION
#	To be used when a precondition for the test fails and the test
#	should be skipped. This routine prints the specified warning message,
#	calls the cleanup procedure if defined, prints a final test skipped
#	message, and exits the test with exit code -1 (aka 255).
#
# NOTE
#	DO NOT call this within your local cleanup procedure.
#
################################################################

proc skip { message } {
	global _incomplete_reason STATUS_SKIP

	# Avoid recursive calls from within cleanup
	if {[info level] > 1 && [lindex [info level -1] 0] eq "cleanup"} {
		log_error "Local cleanup shouldn't call pass, fail or skip"
		return
	}

	log_warn $message
	set _incomplete_reason $message

	# _test_fini will handle cleanup and print the skipped message.
	_test_fini $STATUS_SKIP
}


################################################################
#
# NAME
#	pass - passes a test
#
# SYNOPSIS
#	pass
#
# DESCRIPTION
#	To be used when a test passes and should complete with success.
#	This routine calls the cleanup procedure if defined, prints a final
#	test success message, and exits with exit code 0.
#
# NOTE
#	DO NOT call this within your local cleanup procedure.
#
################################################################

proc pass { } {
	global STATUS_PASS

	# Avoid recursive calls from within cleanup
	if {[info level] > 1 && [lindex [info level -1] 0] eq "cleanup"} {
		log_error "Local cleanup shouldn't call pass, fail or skip"
		return
	}

	# _test_fini will handle cleanup and print the success message.
	_test_fini $STATUS_PASS
}


################################################################
#
# NAME
#	subpass - registers a passing subtest result
#
# SYNOPSIS
#	subpass ?description?
#
# DESCRIPTION
#	Increments the subtest pass count and logs a passing subtest message
#
# ARGUMENTS
#	description
#		A single-line string describing the subtest being verified
#
################################################################

proc subpass args {
	global _subtest_fail_count _subtest_pass_count _subtest_skip_count
	global _subtest_messages

	set description ""
	set argument_count [llength $args]
	if {$argument_count == 1} { set args [lassign $args description] }
	if {$argument_count > 1} {
		fail "Too many arguments ($argument_count): $args"
	}

	set subtest_count [expr $_subtest_pass_count + $_subtest_fail_count + $_subtest_skip_count + 1]
	incr _subtest_pass_count
	set message [format "Subtest %2d passed" $subtest_count]
	if {$description ne ""} { append message "  : $description" }
	log_pass $message
	dict set _subtest_messages $subtest_count [list pass $message]
}


################################################################
#
# NAME
#	subfail - registers a failing subtest result
#
# SYNOPSIS
#	subfail ?options? ?description? ?diagnostics?
#
# DESCRIPTION
#	Increments the subtest failure count and logs a failing subtest message
#
# OPTIONS
#	-fatal
#		Causes this subtest failure to be fatal, ending the test
# ARGUMENTS
#	description
#		A single-line string describing the condition being verified
#	diagnostics
#		A string providing additional diagnostic information that will
#		be included with the log message
#
# ENVIRONMENT
#	testsuite_subtest_fatal
#		Specifies whether first failing subtest aborts the test
#
################################################################

proc subfail args {
	global _subtest_fail_count _subtest_pass_count _subtest_skip_count
	global testsuite_subtest_fatal
	global _subtest_messages

	set description ""
	set fatal       false
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fatal   {set fatal true; set args [lrange $args 1 end]}
			-*       {fail "Unknown option: [lindex $args 0]"}
			default  break
		}
	}
	set argument_count [llength $args]
	if {$argument_count >= 1} { set args [lassign $args description] }

	set subtest_count [expr $_subtest_pass_count + $_subtest_fail_count + $_subtest_skip_count + 1]
	incr _subtest_fail_count
	set message [format "Subtest %2d failed" $subtest_count]
	if {$description ne ""} { append message "  : $description" }
	if [llength $args] { append message " (" [join $args ", "] ")" }
	if {$fatal || $testsuite_subtest_fatal} {
		fail $message
	} else {
		log_error $message
	}
	dict set _subtest_messages $subtest_count [list fail $message]
}


################################################################
#
# NAME
#	subskip - registers a skipped subtest result
#
# SYNOPSIS
#	subskip ?options? ?description?
#
# DESCRIPTION
#	Increments the subtest skip count and logs a skipped subtest message
#
# OPTIONS
#	-count NUMBER
#		When used with -skip, indicates the number of subtests that
#		were skipped
# ARGUMENTS
#	description
#		A single-line string describing the reason the subtest is
#		being skipped
#
################################################################

proc subskip args {
	global _subtest_fail_count _subtest_pass_count _subtest_skip_count
	global _subtest_messages

	set description ""
	set count       1
	set nolog       0
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-nolog {
				set nolog 1
				# Shift args down one
				set args [lassign $args -]
			}
			-count   {set args [lassign $args - count]}
			-*       {fail "Unknown option: [lindex $args 0]"}
			default  break
		}
	}
	set argument_count [llength $args]
	if {$argument_count == 1} { set args [lassign $args description] }
	if {$argument_count > 1} {
		fail "Too many arguments ($argument_count): $args"
	}

	set subtest_count [expr $_subtest_pass_count + $_subtest_fail_count + $_subtest_skip_count + 1]
	incr _subtest_skip_count $count
	if {$count > 1} {
		set message "Subtest $subtest_count-[expr $subtest_count+$count-1] skipped"
	} else {
		set message [format "Subtest %2d skipped" $subtest_count]
	}
	if {$description ne ""} { append message " : $description" }
	if {$nolog != 1} {
		log_warn $message
	}
	dict set _subtest_messages [expr $subtest_count] [list skip $message]
}


################################################################
#
# NAME
#	get_subtest_fail_count - returns the current subtest failure count
#
# SYNOPSIS
#	get_subtest_fail_count
#
################################################################

proc get_subtest_fail_count {} {
	global _subtest_fail_count

	return $_subtest_fail_count
}


################################################################
#
# NAME
#	reset_bash_prompt - used in expect body to reset bash prompt
#
# SYNOPSIS
#	reset_bash_prompt
#
# DESCRIPTION
#	The procedure must be called within an expect body to
#	reset the bash prompt to the $test_prompt.
#
# EXAMPLE
#	spawn $salloc $bin_bash
#	expect {
#		-re "Granted job allocation ($number)" {
#			set job_id $expect_out(1,string)
#			reset_bash_prompt
#			exp_continue
#		}
#		-re $test_prompt {}; # Expect initial test prompt from bash
#		timeout {
#			fail "salloc not responding or prompt not recognized"
#		}
#	}
#
################################################################

proc reset_bash_prompt {} {
	global testsuite_dir

	upvar spawn_id sid
	send -i $sid "source $testsuite_dir/reset_bash_prompt.sh\n"
}


################################################################
#
# NAME
#	print_time - prints the current date and time
#
# SYNOPSIS
#	print_time
#
################################################################

proc print_time { } {
	global bin_date

	spawn $bin_date
	expect {
		eof {
			wait
		}
	}

	return
}

################################################################
#
# NAME
#	dict_getdef - 'dict get' with ability to specify the default value
#
# SYNOPSIS
#	dict_getdef dictionary_value key default_value
#
# DESCRIPTION
#	Tcl < 8.7 lacks a built in 'dict get' with ability to specify the
#	default value. Tcl 8.7 adds a dict getdef.
#	This proc returns the value from the dictionary corresponding to the
#	keys if it exists, or the default value otherwise.
#
# EXAMPLE
#	dict_getdef $option_dict action "warn"
#
# SOURCE
#	https://core.tcl-lang.org/tips/doc/trunk/tip/342.md
#	https://core.tcl-lang.org/tcl/tktview/2370575
#
################################################################

proc dict_getdef {D args} {
	if {[dict exists $D {*}[lrange $args 0 end-1]]} then {
		dict get $D {*}[lrange $args 0 end-1]
	} else {
		lindex $args end
	}
}


################################################################
#
# NAME
#	_line_trace - returns an abbreviated call stack trace with line numbers
#
# SYNOPSIS
#	_line_trace
#
################################################################

proc _line_trace {} {
	set line_trace  ""
	set first_entry true
	for {set f [expr [info frame] - 3]} {$f >= 1} {incr f -1} {
		set frame_dict [info frame $f]
		if [dict exists $frame_dict file] {
			if [regexp uplevel [dict get $frame_dict cmd]] {
				continue
			}
			if {$first_entry} {
				set first_entry false
			} else {
				append line_trace ","
			}
			if [dict exists $frame_dict proc] {
				set proc [namespace tail [dict get $frame_dict proc]]
				if {$proc ne ""} {
					append line_trace "$proc\@"
				}
			}
			append line_trace [file tail [dict get $frame_dict file]]
			if [dict exists $frame_dict line] {
				append line_trace ":[dict get $frame_dict line]"
			}
		}
	}
	return $line_trace
}


################################################################
#
# NAME
#	tolerance - determines whether a value is within a specified tolerance
#
# SYNOPSIS
#	tolerance expected observed tolerance_expression
#
# ARGUMENTS
#	expected
#		the expected (numeric) value
#	observed
#		the observed (numeric) value
#	tolerance_expression
#		a string of the form: [~][+|-]<tolerance>[%]
#
# DESCRIPTION
#	tolerance
#		A numeric tolerance
#	symmetry
#		By default the permitted range of values is symetric:
#			[expected - tolerance, expected + tolerance]
#		If the + sign is specified, the tolerance is limited to the
#		the higher side only:
#			[expected, expected + tolerance]
#		If the - sign is specified, the tolerance is limited to the
#		the lower side only:
#			[expected - tolerance, expected]
#	percent
#		By default the permitted range is computed as absolute values:
#			[expected - tolerance, expected + tolerance]
#		If % is specified, the permitted range is computed as a
#		percentage of the expected value:
#			[expected*(1-tolerance/100), expected*(1+tolerance/100)]
#	exclusivity
#		By default the permitted range of values is inclusive, ie
#		the min and max tolerated values are included in the range:
#			[expected - tolerance, expected + tolerance]
#		If ~ (exclusive) is specified, the tolerance limits are
#		exclusive, ie the min and max tolerated values are excluded:
#			(expected - tolerance, expected + tolerance)
#	expression
#		any combination of symetry, percent and exclusivity is allowed
#
# RETURN VALUE
#	Returns true if the observed value is within the specified tolerance
#	range of the expected value, otherwise false
#
# EXAMPLES
#	The indicated tolerance_expression is true if:
#	"5"     expected - 5  <= observed <= expected + 5
#	"-5"    expected - 5  <= observed <= expected
#	"+5"    expected      <= observed <= expected + 5
#	"5%"    expected - 5% <= observed <= expected + 5%
#	"~5"    expected - 5  <  observed <  expected + 5
#	"~+5%"  expected      <= observed <  expected + 5%
#
################################################################

proc tolerance { expected observed tolerance_expression } {
	if {![regexp {^(~?)([-+]?)([0-9\.]+)(%?)$} $tolerance_expression {} exclusive sign tolerance percent]} {
		fail "Invalid tolerance expression ($tolerance_expression)"
	}

	set lower_bound_expression $observed
	if {$sign eq "+" || $exclusive ne "~"} {
		append lower_bound_expression " >="
	} else {
		append lower_bound_expression " >"
	}
	append lower_bound_expression " $expected"
	if {$sign eq "-" || $sign eq ""} {
		if {$percent eq "%"} {
			append lower_bound_expression " - $tolerance * $expected / 100"
		} else {
			append lower_bound_expression " - $tolerance"
		}
	}

	set upper_bound_expression $observed
	if {$sign eq "-" || $exclusive ne "~"} {
		append upper_bound_expression " <="
	} else {
		append upper_bound_expression " <"
	}
	append upper_bound_expression " $expected"
	if {$sign eq "+" || $sign eq ""} {
		if {$percent eq "%"} {
			append upper_bound_expression " + $tolerance * $expected / 100"
		} else {
			append upper_bound_expression " + $tolerance"
		}
	}

	if {[expr $lower_bound_expression] && [expr $upper_bound_expression]} {
		log_debug "$observed is within tolerance $tolerance_expression of $expected"
		return true
	} else {
		log_warn "$observed is not within tolerance $tolerance_expression of $expected"
		return false
	}
}


################################################################
#
# NAME
#	check_run_as_user - check if the caller may run_command as the supplied user
#
# SYNOPSIS
#	check_run_as_user user
#
# DESCRIPTION
#	Note that a proper sudo config needs to be set in orther to pass this
#	check. Calling user should be permitted to run_commands as the
#	supplied user using sudo without password.
#	See the -user option of run_command.
#	This proc also log_warn a message if user already exists in the DB
#	because most probably this user is testsuite_user and that user is
#	expected NOT to be in the DB and could potentially be removed from it by
#	the test.
#
# RETURN VALUE
#	Returns a boolean value indicating whether the calling user may
#	run_command as user.
#
################################################################

proc check_run_as_user user {
	global bin_id

	if {$user eq ""} {
		return false
	}
	if {[run_command_status -none -user $user "$bin_id -un"]} {
		return false
	}

	if {[get_admin_level $user] != ""} {
		log_warn "User $user already exists in DB, but it's probable that it's going to be removed by the test cleanup"
	}

	return true
}


################################################################
#
# NAME
#	check_user_id - check if user exists in the system
#
# SYNOPSIS
#	check_user_id user
#
# DESCRIPTION
#	This proc also log_warn a message if user already exists in the DB
#	because most probably this user is testsuite_user and that user is
#	expected NOT to be in the DB and could potentially be removed from
#	it by the test.
#
# RETURN VALUE
#	Returns true if the user passed exists in the system, false otherwise.
#
################################################################

proc check_user_id user {
	global bin_id

	if {$user eq ""} {
		return false
	}
	if {[run_command_status -none "$bin_id -un $user"]} {
		return false
	}

	if {[get_admin_level $user] != ""} {
		log_warn "User $user already exists in DB, but it's probable that it's going to be removed by the test cleanup"
	}

	return true
}


################################################################
#
# NAME
#	run_command - executes a command and returns a dictionary result
#
# SYNOPSIS
#	run_command ?options? command
#
# DESCRIPTION
#	Executes a command and returns a dictionary that includes the output,
#	exit code, etc. An action can be taken (fail, warn, subtest, none) if
#	the command's exit code is unexpected. By default, the action
#	will be applied if the command fails. If the -xfail option is
#	specified, the behavior will be reversed to apply the action if the
#	command ran successfully.
#	A timeout is always treated as unexpected, so log_error will be shown
#	by default, or fail/subfail will be called if -fail/-subtest are used.
#
# OPTIONS
#	-fail
#		If the exit code is unexpected, the action that will
#		be taken is to fail the test
#	-subtest
#		If the exit code is unexpected, the action that will
#		be taken is to subfail, otherwise subpass will be called
#	-warn
#		If the exit code is unexpected, the action that will
#		be taken is to log a warning (this is the default)
#	-none
#		If the exit code is unexpected, no action will be taken
#	-xfail
#		If the command exits with zero the action will be applied.
#		Without this option, the action will be applied if the
#		command exits with a non-zero exit code.
#	-timeout <float_number>
#		Time in seconds to wait for the command to complete before
#		timing out (default is 60.0)
#	-nolog
#		Logging for this command will occur at trace threshold only
#	-stdin
#		Provide standard in to be piped into command
#	-user <user>
#		Attempt to execute command as <user>. Note that sudo must be
#		properly configured to permit the caller to execute as <user>.
#		See check_run_as_user.
#
# ARGUMENTS
#	command
#		a string containing the command and arguments to execute
#
# RETURN VALUE
#	A dictionary containing the following elements:
#		command    - The command that was invoked
#		exit_code  - Exit code
#		output     - The combined standard output and standard error
#		start_time - The time (with ms) the command was executed
#		duration   - The duration (seconds and milliseconds) the
#		             command took to run
#
################################################################
proc run_command args {
	global bin_bash bin_sudo

	set alt_user ""
	set exit_status 0
	set timedout false
	set output ""
	set action "warn"
	set timeout 60
	set expect_failure false
	set log_at_trace_level false
	set stdin ""
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail    {set action "fail"; set args [lrange $args 1 end]}
			-subtest {set action "subtest"; set args [lrange $args 1 end]}
			-none    {set action "none"; set args [lrange $args 1 end]}
			-timeout {set args [lassign $args - timeout]}
			-warn    {set action "warn"; set args [lrange $args 1 end]}
			-xfail   {set expect_failure true; set args [lrange $args 1 end]}
			-nolog   {set log_at_trace_level true; set args [lrange $args 1 end]}
			-stdin   {set stdin [lindex $args 1]; set args [lassign $args - stdin]}
			-user    {set args [lassign $args - alt_user]}
			-*       {fail "Unknown option: [lindex $args 0]"}
			default  break
		}
	}
	if {[llength $args] == 1} {
		lassign $args command
	} else {
		fail "Invalid number of arguments [llength $args]: $args"
	}

	if {$action eq "subtest"} {
		if {$expect_failure} {
			set test_description "Command \"$command\" should fail"
		} else {
			set test_description "Command \"$command\" should succeed"
		}
	}

	if {$log_at_trace_level} {
		interp alias {} log_run     {} log_trace
		interp alias {} log_details {} log_trace
	} else {
		interp alias {} log_run     {} log_command
		interp alias {} log_details {} log_debug
	}

	set orig_log_user [log_user -info]
	log_user 0

	if {$alt_user ne ""} {
		log_run "Run Command as user $alt_user: $command"
	} else {
		log_run "Run Command: $command"
	}
	set start_clock_ms [clock milliseconds]
	set stty_init raw ; # Prevent the terminal from inserting \r
	if {$alt_user ne ""} {
		set expect_pid [spawn -noecho $bin_sudo -nu $alt_user $bin_bash -c "$command"]
	} else {
		set expect_pid [spawn -noecho $bin_bash -c "$command"]
	}
	if { $stdin != "" } {
		exp_send "$stdin"
		set command "$command <<< $stdin"
	}
	expect {
		-re "(.+)" {
			append output $expect_out(1,string)
			exp_continue
		}
		timeout {
			slow_kill $expect_pid
			set exit_status $::RETURN_TIMEOUT
			set timedout true
		}
		eof {
			lassign [wait] pid spawnid os_error_flag errno
			set exit_status [expr $errno > 128 ? $errno - 256 : $errno]
		}
	}
	set start_time [format "%.3f" [expr $start_clock_ms / 1000.000]]
	set end_time [format "%.3f" [expr [clock milliseconds] / 1000.000]]
	set duration [format "%.3f" [expr $end_time - $start_time]]

	log_details "Command Results:"
	log_details "	Duration:   $duration"
	log_details "	Exit Code:  $exit_status"
	if {[info exists output]} {
		log_details "	Output: $output"
	}

	if {$timedout} {
		set message "Command \"$command\" timed out after $timeout seconds"
		if {$action eq "fail"} {
			fail $message
		} elseif {$action eq "subtest"} {
			subfail $test_description $message
		} else {
			log_error $message
		}
	} elseif {! $expect_failure && $exit_status != 0} {
		set message "Command \"$command\" failed with rc=$exit_status"
		if {[info exists output] && $output != ""} {
			append message ": [string trimright $output]"
		}
		if {$action eq "warn"} {
			log_warn $message
		} elseif {$action eq "subtest"} {
			subfail $test_description $message
		} elseif {$action eq "fail"} {
			fail $message
		}
	} elseif {$expect_failure && $exit_status == 0} {
		set message "Command \"$command\" was expected to fail but succeeeded"
		if {$action eq "warn"} {
			log_warn $message
		} elseif {$action eq "subtest"} {
			subfail $test_description $message
		} elseif {$action eq "fail"} {
			fail $message
		}
	} elseif {$action eq "subtest"} {
		subpass $test_description
	}
	log_user $orig_log_user

	dict set result command    $command
	dict set result exit_code  $exit_status
	dict set result output     $output
	dict set result start_time $start_time
	dict set result duration   $duration

	return $result
}


################################################################
#
# NAME
#	run_command_output - executes a command and returns the output
#
# SYNOPSIS
#	run_command_output ?options? command
#
# DESCRIPTION
#	Executes a command and returns a dictionary that includes the output,
#	exit code, etc. An action can be taken (fail, warn, none)  if the
#	command's exit code or timeout is unexpected. By default, the action
#	will be applied if the command fails. If the -xfail option is
#	specified, the behavior will be reversed to apply the action if the
#	command ran successfully.
#
# OPTIONS
#	-fail
#		if the exit code or timeout is unexpected, the action that will
#		be taken is to fail the test
#	-warn
#		if the exit code or timeout is unexpected, the action that will
#		be taken is to log a warning (this is the default)
#	-none
#		if the exit code or timeout is unexpected, no action will be
#		taken
#	-xfail
#		if the command exits with zero and does not time out, the
#		action will be applied. Without this option, the action will
#		be applied if the command exits with a non-zero exit code or
#		times out.
#	-timeout <float_number>
#		time in seconds to wait for the command to complete before
#		timing out (default is 60.0)
#	-stdin
#		Provide standard in to be piped into command
#
# ARGUMENTS
#	command
#		a string containing the command and arguments to execute
#
# RETURN VALUE
#	A string containing the combined standard output and standard error
#
################################################################

proc run_command_output args {

	set result [run_command {*}$args]

	if [dict exists $result output] {
		return [dict get $result output]
	} else {
		return ""
	}
}


################################################################
#
# NAME
#	run_command_status - executes a command and returns the exit code
#
# SYNOPSIS
#	run_command_status ?options? command
#
# DESCRIPTION
#	Executes a command and returns a dictionary that includes the output,
#	exit code, etc. An action can be taken (fail, warn, none)  if the
#	command's exit code or timeout is unexpected. By default, the action
#	will be applied if the command fails. If the -xfail option is
#	specified, the behavior will be reversed to apply the action if the
#	command ran successfully.
#
# OPTIONS
#	-fail
#		if the exit code or timeout is unexpected, the action that will
#		be taken is to fail the test
#	-warn
#		if the exit code or timeout is unexpected, the action that will
#		be taken is to log a warning (this is the default)
#	-none
#		if the exit code or timeout is unexpected, no action will be
#		taken
#	-xfail
#		if the command exits with zero and does not time out, the
#		action will be applied. Without this option, the action will
#		be applied if the command exits with a non-zero exit code or
#		times out.
#	-timeout <float_number>
#		time in seconds to wait for the command to complete before
#		timing out (default is 60.0)
#	-stdin
#		Provide standard in to be piped into command
#
# ARGUMENTS
#	command
#		a string containing the command and arguments to execute
#
# RETURN VALUE
#	The exit code for the invoked command
#
################################################################

proc run_command_status args {

	set result [run_command {*}$args]

	return [dict get $result exit_code]
}


################################################################
#
# NAME
#	cancel_job - cancels the specified job list
#
# SYNOPSIS
#	cancel_job job_id_list ?het_job?
#
# DESCRIPTION
#	Cancels one or more jobs. A job_id of 0 will be silently ignored.
#
# OPTIONS
#	-fail
#		if scancel fails with exit code or timeout, or the job doesn't
#		end, test will will fail
#
# ARGUMENTS
#	job_id_list
#		The list of Slurm job ids that we want to cancel
#	het_job
#		1 if jobs are hetjobs and we want to confirm each
#		component has completed
#
# RETURN VALUE
#	RETURN_SUCCESS if jobs are cancelled, or non-zero value otherwise.
#
################################################################

proc cancel_job args {
	global scancel

	set fatal         false
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail   {set fatal true; set args [lrange $args 1 end]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}

	set argument_count [llength $args]
	if {$argument_count < 1} {
		fail "Too few arguments ($argument_count): $args"
	} elseif {$argument_count > 2} {
		fail "Too many arguments ($argument_count): $args"
	}
	lassign $args job_id_list
	if {$argument_count == 2} {
		set het_job [lindex $args 1]
	} else {
		set het_job 0
	}

	set job_list_clean [list]
	foreach job_id $job_id_list {
		if {$job_id != 0} {
			lappend job_list_clean $job_id
		}
	}

	if {![llength $job_list_clean]} {
		return $::RETURN_SUCCESS
	}

	log_debug "Cancelling $job_list_clean"
	set result [run_command "$scancel -Q $job_list_clean"]
	if {[dict get $result exit_code]} {
		set message "scancel command returned an error ([dict get $result output])"
		if {$fatal} {
			fail $message
		} else {
			log_warn $message
			return $::RETURN_ERROR
		}
	}
	foreach job_id $job_list_clean {
		if {[wait_for_job $job_id "DONE" $het_job]} {
			set message "Job ($job_id) did not end when cancelled"
			if {$fatal} {
				fail $message
			} else {
				log_warn $message
				return $::RETURN_ERROR
			}
		}
	}
	return $::RETURN_SUCCESS
}


################################################################
#
# NAME
#	get_line_cnt - returns the size of the specified file
#
# SYNOPSIS
#	get_line_cnt file_name
#
# RETURN VALUE
#	Number of lines in the specified file.
#
################################################################

proc get_line_cnt { file_name } {
	global bin_wc number
	set lines 0
	spawn $bin_wc -l $file_name
	expect {
		-re "($number) " {
			set lines $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	return $lines
}


################################################################
#
# NAME
#	convert_time_str - Converts a string like [HH:]MM:SS[.sss] to secs
#
# SYNOPSIS
#	Convert the string to a number.
#
# DESCRIPTION
#	Units can be hours, mins, secs.
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
################################################################

proc convert_time_str { time_str units } {
	subtest {[regexp {(?:(\d+):)?(\d+):(\d+)(?:\.(\d+))?} $time_str - hours mins secs msecs]} "Time should be in the format \[HH:\]MM:SS\[.sss\]" "$time_str"
	if { $hours eq "" } {
		set hours 0
	}

	# Use scan to avoid TCL octals
	set value  [expr ([scan $hours "%d"] * 3600) + ([scan $mins "%d"] * 60) + [scan $secs "%d"]]

	if { $units eq "hours" } {
		set value [expr $value / 3600]
	} elseif { $units eq "mins" } {
		set value [expr $value / 60]
	}

	return $value
}


################################################################
#
# NAME
#	slow_kill - kills a process slowly
#
# SYNOPSIS
#	slow_kill pid
#
# DESCRIPTION
#	Kill a process slowly, first trying SIGINT, pausing for
#       a second, then sending SIGKILL.
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
################################################################

proc slow_kill { pid } {
	global bin_kill

	catch {exec $bin_kill -INT $pid}
	catch {exec $bin_kill -INT $pid}
	sleep  1
	catch {exec $bin_kill -KILL $pid}

	return 0
}


################################################################
#
# NAME
#	get_my_id - gets the id from the running user
#
# SYNOPSIS
#	get_my_id
#
# RETURN VALUE
#	output of id
#
################################################################

proc get_my_id {} {

	global bin_id number
	set login_info -1

	log_user 0

	spawn $bin_id
	expect {
		-re "(uid=.*\n)" {
			set login_info $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}

	log_user 1

	if {$login_info == -1} {
		fail "Unable to get user info"
	}

	return $login_info
}


################################################################
#
# NAME
#	get_my_user_name - gets the name from the running user
#
# SYNOPSIS
#	get_my_user_name
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
################################################################

proc get_my_user_name {  } {
	global bin_id re_word_str

	set user_name -1

	log_user 0
	spawn $bin_id -nu
	expect {
		-re "($re_word_str)" {
			set user_name $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	if {$user_name == -1} {
		fail "Unable to get user name"
	}

	return $user_name
}


################################################################
#
# NAME
#	get_my_uid - gets the uid from the running user
#
# SYNOPSIS
#	get_my_uid
#
# RETURN VALUE
#	The uid of the current user, or fails.
#
################################################################

proc get_my_uid {  } {
	global bin_id number

	set out [run_command_output -nolog -fail "$bin_id -u"]
	if {![regexp "($number)" $out - uid]} {
		fail "Unable to get UID with $bin_id ($out)"
	}

	return $uid
}


################################################################
#
# NAME
#	get_my_gid - gets the gid from the running user
#
# SYNOPSIS
#	get_my_gid
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
################################################################

proc get_my_gid {  } {
	global bin_id number

	set gid -1

	log_user 0
	spawn $bin_id -g
	expect {
		-re "($number)" {
			set gid $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	return $gid
}


################################################################
#
# NAME
#	kill_salloc - kills all salloc commands associated with this user
#
# SYNOPSIS
#	kill_salloc
#
# DESCRIPTION
#	Kill all salloc commands associated with this user.
#	Issue two SIGINT, sleep 1 and a SIGKILL
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
# NOTE
#	Use slow_kill instead of kill_salloc if you can capture
#	the process id
#
################################################################

proc kill_salloc {  } {
	global bin_id bin_pkill bin_sleep number

	set uid [get_my_uid]
	catch {exec $bin_pkill -INT -u $uid salloc}
	catch {exec $bin_pkill -INT -u $uid salloc}
	sleep  1
	catch {exec $bin_pkill -KILL -u $uid salloc}

	return 0
}


################################################################
#
# NAME
#	kill_srun - kills all srun commands associated with this user
#
# SYNOPSIS
#	kill_srun
#
# DESCRIPTION
#	Kill all srun commands associated with this user.
#	Issue two SIGINT, sleep 1 and a SIGKILL
#
# RETURN VALUE
#	A non-zero return code indicates a failure.
#
# NOTE
#	Use slow_kill instead of kill_srun if you can capture
#	the process id
#
################################################################

proc kill_srun {  } {
	global bin_id bin_pkill bin_sleep number

	set uid [get_my_uid]
	catch {exec $bin_pkill -INT -u $uid srun}
	catch {exec $bin_pkill -INT -u $uid srun}
	sleep  1
	catch {exec $bin_pkill -KILL -u $uid srun}

	return 0
}


################################################################
#
# NAME
#	wait_for - generic wait utility
#
# SYNOPSIS
#	wait_for ?options? condition body
#
# DESCRIPTION
#	Generic wait utility allowing you to repeatedly execute a generic block
#	of code until a specified boolean expression is met. The code block and
#	condition check occur every poll interval until a timeout is reached.
#
# OPTIONS
#	-fail
#		fail the test if the condition is not met within the timeout
#	-subtest
#		if the condition is met within the timeout call subpass, otherwise
#		call subfail
#	-timeout <float_number>
#		time in seconds to wait for the condition to be met before
#		timing out (default is 60.0)
#	-pollinterval <float_number>
#		time in seconds between each loop execution and condition check
#		(default is 1.0)
#
# ARGUMENTS
#	condition
#		The boolean expression to test
#	body
#		A block of code to evaluate in the invoking stack frame
#
# RETURN VALUE
#	RETURN_SUCCESS if the condition is met before the timeout occurs,
#	RETURN_TIMEOUT if the timeout occurs before the condition is met
#
################################################################

proc wait_for args {
	set action          "none"
	set subtest         false
	set timeout         60
	set poll_interval   1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail       {set action "fail"; set args [lrange $args 1 end]}
			-subtest    {set action "subtest"; set args [lrange $args 1 end]}
			-time*      {set args [lassign $args - timeout]}
			-poll*      {set args [lassign $args - poll_interval]}
			-*          {fail "Unknown option: [lindex $args 0]"}
			default     break
		}
	}
	if {[llength $args] == 2} {
		lassign $args condition body
	} else {
		fail "Invalid number of arguments [llength $args]: $args"
	}

	set start_time [format "%.3f" [expr [clock milliseconds] / 1000.000]]

	log_debug "Waiting for $condition"

	while {1} {
		# Evaluate code block
		log_trace "Evaluating code block ([string trim $body])"
		uplevel $body

		# Check condition
		if {[uplevel expr [format "{%s}" $condition]]} {
			set now [format "%.3f" [expr [clock milliseconds] / 1000.000]]
			log_debug "Condition ($condition) was met"
			if {$action eq "subtest"} {
				subpass "Condition ($condition) should be met (within $timeout seconds)"
			}
			return $::RETURN_SUCCESS
		} else {
			log_trace "Condition ($condition) was not met"
		}

		# Sleep poll interval
		log_trace "Sleeping for $poll_interval seconds"
		after [expr {int($poll_interval * 1000)}]

		# Check if we have surpassed our timeout
		set now [format "%.3f" [expr [clock milliseconds] / 1000.000]]
		log_trace "Checking whether the current time ([clock format [expr int($now)] -format %Y-%m-%dT%X].[lindex [split $now '.'] 1]) is greater than the start time plus the timeout ([clock format [expr int($start_time + $timeout)] -format %Y-%m-%dT%X].[lindex [split [expr $start_time + $timeout] '.'] 1])"
		if {$now > $start_time + $timeout} {
			set message "Condition ($condition) was not met before timeout ($timeout seconds)"
			if {$action eq "fail"} {
				fail $message
			} else {
				log_warn $message
				if {$action eq "subtest"} {
					subfail "Condition ($condition) should be met (within $timeout seconds)" "Timed out"
				}
				return $::RETURN_TIMEOUT
			}
		}
	}
}


################################################################
#
# NAME
#	wait_for_command - repeat a command until it is successful or meets a specified condition
#
# SYNOPSIS
#	wait_for_command ?options? command ?condition?
#
# DESCRIPTION
#	A command is repeated until it meets a condition or a timeout is reached.
#	If a condition is not specified, the command will be repeated until it
#	is successful (the exit code is zero).
#
# OPTIONS
#	-fail
#		fail the testif the condition is not met within the timeout
#	-subtest
#		if the condition is met within the timeout call subpass, otherwise
#		call subfail
#	-timeout <float_number>
#		time in seconds to wait for the condition to be met before
#		timing out (default is 60.0)
#	-pollinterval <float_number>
#		time in seconds between each loop execution and condition
#		check (default is 1.0)
#
# ARGUMENTS
#	command
#		a string containing the command and arguments to execute
#	condition
#		The boolean expression to test. For each command invocation,
#		the result variable will be set to the dictionary returned
#		from run_command.
#		The condition expression will normally involve a comparison
#		with one or more values of this dictionary. If a condition is
#		not specified, this condition will be used:
#		{ [dict get $result exit_code] == 0 }
#
# RETURN VALUE
#	RETURN_SUCCESS if the condition is met before the timeout occurs,
#	RETURN_TIMEOUT if the timeout occurs before the condition is met
#
################################################################

proc wait_for_command args {
	set action          "none"
	set timeout         60
	set poll_interval   1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail       {set action "fail"; set args [lrange $args 1 end]}
			-subtest    {set action "subtest"; set args [lrange $args 1 end]}
			-time*      {set args [lassign $args - timeout]}
			-poll*      {set args [lassign $args - poll_interval]}
			-*          {fail "Unknown option: [lindex $args 0]"}
			default     break
		}
	}

	set argument_count [llength $args]
	if {$argument_count < 1} {
		fail "Too few arguments ($argument_count): $args"
	} elseif {$argument_count > 2} {
		fail "Too many arguments ($argument_count): $args"
	}
	lassign $args command
	if {$argument_count == 2} {
		set condition [lindex $args 1]
	} else {
		set condition { [dict get $result exit_code] == 0 }
	}

	set start_time [format "%.3f" [expr [clock milliseconds] / 1000.000]]

	log_debug "Waiting for $condition"

	while {1} {
		# Run command
		set result [run_command $command]

		# Check condition
		if {[eval expr [format "{%s}" $condition]]} {
			set now [format "%.3f" [expr [clock milliseconds] / 1000.000]]
			log_debug "Condition ($condition) was met"
			if {$action eq "subtest"} {
				subpass "Condition ($condition) should be met (within $timeout seconds)"
			}
			return $::RETURN_SUCCESS
		} else {
			log_trace "Condition ($condition) was not met"
		}

		# Sleep poll interval
		log_trace "Sleeping for $poll_interval seconds"
		after [expr {int($poll_interval * 1000)}]

		# Check whether we have surpassed our timeout
		set now [format "%.3f" [expr [clock milliseconds] / 1000.000]]
		log_trace "Checking whether the current time ([clock format [expr int($now)] -format %Y-%m-%dT%X].[lindex [split $now '.'] 1]) is greater than the start time plus the timeout ([clock format [expr int($start_time + $timeout)] -format %Y-%m-%dT%X].[lindex [split [expr $start_time + $timeout] '.'] 1])"
		if {$now > $start_time + $timeout} {
			set message "Condition ($condition) was not met before timeout ($timeout seconds)"
			if {$action eq "fail"} {
				fail $message
			} else {
				log_warn $message
				if {$action eq "subtest"} {
					subfail "Condition ($condition) should be met (within $timeout seconds)" "Timed out"
				}
				return $::RETURN_TIMEOUT
			}
		}
	}
}


################################################################
#
# NAME
#	wait_for_command_match - repeat a command until its output matches the specified pattern
#
# SYNOPSIS
#	wait_for_command_match ?options? command pattern
#
# DESCRIPTION
#	A command is repeated until its output matches the specified pattern
#
# OPTIONS
#	-negate
#		negates the match. The command is repeated until its output does not
#		match the specified pattern
#	-fail
#		fail the test if the output does not match the pattern within the
#		timeout
#	-subfail
#		if the condition is met within the timeout call subpass, otherwise
#		call subfail
#	-timeout <float_number>
#		time in seconds to wait for the pattern to be matched before
#		timing out (default is 60.0)
#	-pollinterval <float_number>
#		time in seconds between each loop execution and match check
#		(default is 1.0)
#
# ARGUMENTS
#	command
#		a string containing the command and arguments to execute
#	pattern
#		The regular expression to match against the command output
#
# RETURN VALUE
#	RETURN_SUCCESS if the pattern is matched before the timeout occurs,
#	RETURN_TIMEOUT if the timeout occurs before the pattern is matched
#
################################################################

proc wait_for_command_match args {

	set pattern [lindex $args end]
	set args [lrange $args 0 end-1]
	set match 1
	set idx [lsearch $args "-negate"]
	if {$idx != -1} {
		set match 0
		set args [lreplace $args $idx $idx]; # Remove the -negate argument
	}

	return [wait_for_command {*}$args "\[regexp -- {$pattern} \[dict get \$result output\]\] == $match"]
}


################################################################
#
# NAME
#	wait_for_file - waits for a file to exist with non-zero size
#
# SYNOPSIS
#	wait_for_file ?options? file_name
#
# OPTIONS
#	-fail
#		If an error occurs or the file does not become present
#		by the timeout, fail the test rather than returning an error
#	-timeout <integer_number>
#		time in seconds to wait for the file to exist before
#		timing out (default is 90)
#	-pollinterval <integer_number>
#		time in seconds between each file existence test (default is 1)
#
# DESCRIPTION
#	Wait for the specified file to exist and have a non-zero size.
#	Note that if JobFileAppend=0 is configured, a file can exist and
#	be purged then be re-created.
#
# RETURN VALUE
#	RETURN_SUCCESS if the file becomes present within the timeout, or
#	non-zero value otherwise.
#
################################################################

proc wait_for_file args {
	global bin_sleep

	set fatal         false
	set timeout       90
	set poll_interval 1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fatal  -
			-fail   {set fatal true; set args [lrange $args 1 end]}
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count != 1} {
		fail "Invalid number of arguments ($argument_count): $args"
	} else {
		lassign $args file_name
	}

	for {set my_delay 0} {$my_delay <= $timeout} \
	                     {set my_delay [expr $my_delay + $poll_interval]} {
		if {[file exists $file_name]} {
			# Add small delay for I/O buffering
			exec $bin_sleep 1
			return $::RETURN_SUCCESS
		}
		exec $bin_sleep $poll_interval

		# Expect may fail to load current NFS info.
		# Use the ls command to load current info.
		set slash_pos [string last $file_name "/"]
		if {$slash_pos < 1} {
			set dir_name "."
		} else {
			decr slash_pos
			set dir_name [string $file_name 0 $slash_pos]
		}
		exec /bin/ls $dir_name
	}
	set message "Timeout waiting for file ($file_name)"
	if {$fatal} {
		fail $message
	}

	log_warn $message
	return $::RETURN_TIMEOUT
}


################################################################
#
# NAME
#	_wait_for_single_job - waits for a job to reach the desired state
#
# SYNOPSIS
#	_wait_for_single_job ?options? job_id desired_state
#
# DESCRIPTION
#	Wait for a previously submitted Slurm job to reach the desired state.
#
# OPTIONS
#	-fail
#		If an error occurs or the job does not reach the desired state
#		by the timeout, fail the test rather than returning an error
#	-timeout <integer_number>
#		time in seconds to wait for the job to be in the desired state
#		before timing out (default is 360)
#	-pollinterval <integer_number>
#		time in seconds between each job state check (default is 1)
#
# ARGUMENTS
#	job_id
#		The Slurm job id of a job we want to wait for.
#	desired_state
#		The state you want the job to attain before
#		returning.  Currently supports:
#			CANCELLED - job is cancelled
#			DONE      - any terminated state (includes cancelled)
#			PENDING   - job is pending
#			RUNNING   - job is running
#			SPECIAL_EXIT
#			SUSPENDED - job is suspended
#
# RETURN VALUE
#	RETURN_SUCCESS, or non-zero on error.
#
################################################################

proc _wait_for_single_job args {
	global scontrol

	set fatal         false
	set timeout       360
	set poll_interval 1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fatal  -
			-fail   {set fatal true; set args [lrange $args 1 end]}
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count != 2} {
		fail "Invalid number of arguments ($argument_count): $args"
	} else {
		lassign $args job_id desired_state
	}

	# First verify that desired_state is supported
	switch $desired_state {
		"CANCELLED" {}
		"DONE" {}
		"PENDING" {}
		"RUNNING" {}
		"SPECIAL_EXIT" {}
		"SUSPENDED" {}
		default {
			set message "Invalid desired state: $desired_state"
			if {$fatal} {
				fail $message
			}
			log_warn $message
			return $::RETURN_ERROR
		}
	}

	if {$job_id == 0} {
		set message "Invalid job ID ($job_id)"
		if {$fatal} {
			fail $message
		}
		log_warn $message
		return $::RETURN_ERROR
	}

	set my_delay    0
	while 1 {
		set fd [open "|$scontrol -o show job $job_id"]
		gets $fd line
		catch {close $fd}
		if {[regexp {JobState\s*=\s*(\w+)} $line foo state] != 1} {
			set state "NOT_FOUND"
		}

		switch $state {
			"CANCELLED" {
				if {$desired_state eq "CANCELLED"} {
					log_debug "Job $job_id is CANCELLED"
					return $::RETURN_SUCCESS
				}
				if {$desired_state eq "DONE"} {
					log_debug "Job $job_id is DONE ($state)"
					return $::RETURN_SUCCESS
				}
				set message "Job ($job_id) is $state, but we wanted $desired_state"
				if {$fatal} {
					fail $message
				}
				log_debug $message
				return $::RETURN_ERROR
			}
			"NOT_FOUND" -
			"BOOT_FAIL" -
			"COMPLETED" -
			"DEADLINE" -
			"FAILED" -
			"NODE_FAIL" -
			"OUT_OF_MEMORY" -
			"PREEMPTED" -
			"TIMEOUT" {
				if {$desired_state eq "DONE"} {
					log_debug "Job $job_id is DONE ($state)"
					return $::RETURN_SUCCESS
				}
				set message "Job ($job_id) is $state, but we wanted $desired_state"
				if {$fatal} {
					fail $message
				}
				log_debug $message
				return $::RETURN_ERROR
			}
			"PENDING" {
				if {$desired_state eq "PENDING"} {
					log_debug "Job $job_id is PENDING"
					return $::RETURN_SUCCESS
				}
				log_debug "Job $job_id is in state $state, desire $desired_state"
			}
			"RUNNING" {
				if {$desired_state eq "RUNNING"} {
					log_debug "Job $job_id is RUNNING"
					return $::RETURN_SUCCESS
				}
				log_debug "Job $job_id is in state $state, desire $desired_state"
			}
			"SPECIAL_EXIT" {
				if {$desired_state eq "SPECIAL_EXIT"} {
					log_debug "Job $job_id is SPECIAL_EXIT"
					return $::RETURN_SUCCESS
				}
				log_debug "Job $job_id is in state $state, desire $desired_state"
			}
			"SUSPENDED" {
				if {$desired_state eq "SUSPENDED"} {
					log_debug "Job $job_id is SUSPENDED"
					return $::RETURN_SUCCESS
				}
				log_debug "Job $job_id is in state $state, desire $desired_state"
			}
			default {
				log_debug "Job $job_id is in state $state, desire $desired_state"
			}
		}

		if { $my_delay > $timeout } {
			set message "Timeout waiting for job state $desired_state"
			if {$fatal} {
				fail $message
			}
			log_warn "Timeout waiting for job state $desired_state"
			return $::RETURN_TIMEOUT
		}

		exec sleep $poll_interval
		set my_delay [expr $my_delay + $poll_interval]
	}
}


################################################################
#
# NAME
#	wait_for_job - waits for job to be in desired state
#
# SYNOPSIS
#	wait_for_job ?options? job_id desired_state ?het_job?
#
# DESCRIPTION
#	Wait for job to be in desired state. Can handle het job components.
#
# OPTIONS
#	-fail
#		If an error occurs or the job does not reach the desired state
#		by the timeout, fail the test rather than returning an error
#	-timeout <integer_number>
#		time in seconds to wait for the job to be in the desired state
#		before timing out (default is 90)
#	-pollinterval <integer_number>
#		time in seconds between each job state check (default is 1)
#
# ARGUMENTS
#	job_id
#		The Slurm job id of a job we want to wait for.
#	desired_state
#		The state you want the job to attain before returning.
#		Currently supports:
#			CANCELLED - job is cancelled
#			DONE      - any terminated state (including cancelled)
#			PENDING   - job is pending
#			RUNNING   - job is running
#			SPECIAL_EXIT
#			SUSPENDED - job is suspended
#	het_job
#		If set, checks the state of each component job if the job
#		is a het one.
#
# RETURN VALUE
#	RETURN_SUCCESS if job reaches the desired state, or non-zero value
#	otherwise.
#
# SEE ALSO
#	_wait_for_single_job
#
################################################################

proc wait_for_job args {

	set options  [list]
	set het_job  0

	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fatal  -
			-fail   {
				lappend options [lindex $args 0]
				set args [lrange $args 1 end]
			}
			-time*  -
			-poll*  {
				lappend options {*}[lrange $args 0 1]
				set args [lrange $args 2 end]
			}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count < 2} {
		fail "Too few arguments ($argument_count): $args"
	} elseif {$argument_count > 3}  {
		fail "Too many arguments ($argument_count): $args"
	} else {
		lassign $args job_id desired_state
	}
	if {$argument_count == 3} { set hetjob [lindex $args 2] }

	if { $het_job } {
		# get component job ids
		set jid_list [get_het_job_ids $job_id 1]
	}

	set rc       0
	set jid_list ""
	if { $jid_list == "" } {
		# non-het job
		set jid_list $job_id
	}

	foreach jid $jid_list {
		set rc [_wait_for_single_job {*}$options $jid $desired_state]
		if { $rc } {
			# bail out on first failure
			break
		}
	}
	return $rc
}


################################################################
#
# NAME
#	wait_for_job_acct - waits for the job accounting record to be updated
#
# SYNOPSIS
#	wait_for_job_acct ?options? job_id ?field?
#
# DESCRIPTION
#	Wait for evidence that a specific job stage has been recorded in the
#	accounting database by verifying that a field has been populated.
#
# OPTIONS
#	-fail
#		If an error occurs or the job does has not populated the field
#		by the timeout, fail the test rather than returning an error
#	-timeout <integer_number>
#		time in seconds to wait for the job's field to be populated
#		before timing out (default is 90)
#	-pollinterval <integer_number>
#		time in seconds between each field check (default is 1)
#
# ARGUMENTS
#	job_id
#		The Slurm job id of a job we want to wait for.
#	field
#		The field that we are waiting to be populated, not empty and
#		not "Unknown". (Default: End)
#
# RETURN VALUE
#	RETURN_SUCCESS if the desired field has been populated for the job
#	in the accounting database, or non-zero value otherwise.
#
################################################################

proc wait_for_job_acct args {
	global sacct

	set options [list]
	set timeout 10
	set pollinterval .2
	set field End

	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail   {
				lappend options [lindex $args 0]
				set args [lrange $args 1 end]
			}
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - pollinterval]}
			default break
		}
	}
	lappend options -timeout $timeout
	lappend options -pollinterval $pollinterval

	set argument_count [llength $args]
	if {$argument_count < 1} {
		fail "Too few arguments ($argument_count): $args"
	} elseif {$argument_count > 2}  {
		fail "Too many arguments ($argument_count): $args"
	}
	lassign $args job_id
	if {$argument_count == 2} {set field [lindex $args 1]}

	# Wait for sacct to populate the specified field
	# We want to see the field be populated with anything but "Unknown"
	# We can't use a negation match here because empty would match
	return [wait_for_command_match {*}$options "$sacct -j $job_id --allocation --format $field --parsable2 --noheader" (?n)^(?!.*Unknown$).]
}


################################################################
#
# NAME
#	wait_for_account_done - cancels and waits on jobs in specified accounts
#
# SYNOPSIS
#	wait_for_account_done ?options? accounts
#
# DESCRIPTION
#	Cancel jobs on and wait for them to be finished in account(s) given.
#
# OPTIONS
#	-timeout <integer_number>
#		time in seconds to wait for the jobs to be finished before
#		timing out (default is 360)
#	-pollinterval <integer_number>
#		time in seconds between each job state check (default is 1)
#
# ARGUMENTS
#	accounts
#		Comma-delimited list of accounts
#
# RETURN VALUE
#	RETURN_SUCCESS if all jobs of the account are finished, or non-zero
#	otherwise.
#
# NOTE
#	We sleep for two seconds before replying that a job is
#	done to give time for I/O completion (stdout/stderr files)
#
################################################################

proc wait_for_account_done args {
	global scancel squeue re_word_str

	set timeout       360
	set poll_interval 1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count != 1} {
		fail "Invalid number of arguments ($argument_count): $args"
	} else {
		lassign $args accounts
	}

	if { $accounts == "" } {
		fail "An account must be specified"
	}

	log_user 0
	set account_list [split $accounts ","]
	foreach item $account_list {
		spawn $scancel -A $item
		expect {
			timeout {
				log_warn "No response from scancel"
			}
			eof {
				wait
			}
		}
	}

	set my_delay    0
	while 1 {
		set found 0
		spawn $squeue -o Account=%a -h -A$accounts
		expect {
			-re "Account=($re_word_str)" {
				set found 1
				exp_continue
			}
			eof {
				wait
			}
		}

		if { !$found } {
			log_debug "Account(s) $accounts is/are empty"
			break
		}

		if { $my_delay > $timeout } {
			log_error "Timeout waiting for account(s) ($accounts) to be finished"
			log_user 1
			return $::RETURN_TIMEOUT
		}

		exec sleep $poll_interval
		set my_delay [expr $my_delay + $poll_interval]
	}
	log_user 1
	return $::RETURN_SUCCESS
}


################################################################
#
# NAME
#	wait_for_part_done - cancels and waits on jobs in specified partition
#
# SYNOPSIS
#	wait_for_part_done ?options? partition
#
# DESCRIPTION
#	Cancel jobs on and wait for them to be finished in partition given.
#
# OPTIONS
#	-timeout <integer_number>
#		time in seconds to wait for the jobs to be finished before
#		timing out (default is 360)
#	-pollinterval <integer_number>
#		time in seconds between each job state check (default is 1)
#
# ARGUMENTS
#	partition
#		partition name
#
# RETURN VALUE
#	RETURN_SUCCESS if all jobs of the partition are finished, or non-zero
#	otherwise.
#
# NOTE
#	We sleep for two seconds before replying that a job is
#	done to give time for I/O completion (stdout/stderr files)
#
################################################################

proc wait_for_part_done args {
	global scancel squeue re_word_str

	set timeout       360
	set poll_interval 1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count != 1} {
		fail "Invalid number of arguments ($argument_count): $args"
	} else {
		lassign $args partition
	}

	if { $partition == "" } {
		fail "A partition must be specified"
	}

	run_command -fail -nolog "$scancel -p $partition"

	set my_delay    0
	while 1 {
		set found 0
		spawn $squeue -o Part=%P -h -p$partition
		expect {
			-re "Part=($re_word_str)" {
				set found 1
				exp_continue
			}
			eof {
				wait
			}
		}

		if { !$found } {
			log_debug "Partition $partition is empty"
			break
		}

		if { $my_delay > $timeout } {
			log_error "Timeout waiting for partition ($partition) to be finished"
			return $::RETURN_TIMEOUT
		}

		exec sleep $poll_interval
		set my_delay [expr $my_delay + $poll_interval]
	}
	return $::RETURN_SUCCESS
}


################################################################
#
# NAME
#	wait_for_step - waits for a job step to be found
#
# SYNOPSIS
#	wait_for_step ?options? step_id
#
# DESCRIPTION
#	Wait for a job step to be found.
#
# OPTIONS
#	-timeout <integer_number>
#		time in seconds to wait for the job step to be found before
#		timing out (default is 30)
#	-pollinterval <integer_number>
#		time in seconds between each step existence check (default is 1)
#
# ARGUMENTS
#	step_id
#		job step id
#
# RETURN VALUE
#	RETURN_SUCCESS if step_id is found, or non-zero otherwise.
#
################################################################

proc wait_for_step args {
	global scontrol

	set timeout       30
	set poll_interval 1
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count != 1} {
		fail "Invalid number of arguments ($argument_count): $args"
	} else {
		lassign $args step_id
	}

	set my_delay 0
	while 1 {
		set fd [open "|$scontrol -o show step $step_id"]
		gets $fd line
		catch {close $fd}
		if {[regexp {Nodes=} $line foo] == 1} {
			return $::RETURN_SUCCESS
		}
		if {[regexp {MidplaneList=} $line foo] == 1} {
			return $::RETURN_SUCCESS
		}
		if { $my_delay > $timeout } {
			log_warn "Timeout waiting for job step"
			return $::RETURN_TIMEOUT
		}

		log_debug "Step $step_id not done yet. Waiting for $poll_interval seconds"
		exec sleep $poll_interval
		set my_delay [expr $my_delay + $poll_interval]
	}
}


################################################################
#
# NAME
#	wait_job_reason - waits for a desired job state and reason
#
# SYNOPSIS
#	wait_job_reason ?options? job_id ?desired_state? ?desired_reason_list?
#
# DESCRIPTION
#	Wait until the job is in desired state and reason is one
#	of the desired ones or until the timeout.
#
# OPTIONS
#	-timeout <integer_number>
#		time in seconds to wait for the job state and reason before
#		timing out (default is 360)
#	-pollinterval <integer_number>
#		time in seconds between each job state check (default is 1)
#
# ARGUMENTS
#	job_id
#		The job to wait for
#	desired_state
#		Desired state.
#	desired_reason_list
#		List of desired reasons. Empty list means that any reason
#		is ok.
#
# RETURN VALUE
#	RETURN_SUCCESS when job is in the desired state and reason is one
#	of the desired ones, or non-zero otherwise.
#
################################################################

proc wait_job_reason args {
	global scontrol re_word_str

	set final_state "COMPLETED CANCELLED FAILED TIMEOUT DEADLINE
	                 OUT_OF_MEMORY"

	set timeout       360
	set poll_interval 1
	set desired_state "PENDING"
	set desired_reason_list ""
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count < 1} {
		fail "Too few arguments ($argument_count): $args"
	} else {
		lassign $args job_id
	}
	if {$argument_count >= 2} { set desired_state [lindex $args 1] }
	if {$argument_count == 3} { set desired_reason_list [lindex $args 2] }
	if {$argument_count > 3} {
		fail "Too many arguments ($argument_count): $args"
	}

	set log_user_prev [log_user -info]
	log_user 0

	set my_delay 0
	set rc $::RETURN_ERROR
	while true {
		set pending 0
		set has_reason 1
		spawn $scontrol show job $job_id
		expect {
			-re "JobState=($re_word_str) Reason=(\\S+)" {
				set job_state $expect_out(1,string)
				set job_reason $expect_out(2,string)
			}
			timeout {
				log_error "No response from scontrol show job"
				set rc $::RETURN_TIMEOUT
				break
			}
		}

		# Check if both state and reason are the desired ones
		if {$job_state == $desired_state} {
			set found 0
			set reason_msg ""
			if {$desired_reason_list == ""} {
				set found 1
			}
			foreach desired_reason $desired_reason_list {
				if {$job_reason == $desired_reason } {
					set reason_msg " with reason $job_reason"
					set found 1
				}
			}
			if {$found} {
				log_debug "Job $job_id found $job_state$reason_msg"
				set rc $::RETURN_SUCCESS
				break
			}
		} elseif {[lsearch -exact final_state $job_state] >= 0} {
			# Job is in final step no need to wait longer
			log_error [format "Job in final state/reason '%s' / '%s' instead of the desired '%s' / '%s'." \
			                  $job_state $job_reason \
			                  $desired_state $desired_reason_list]
			set rc $::RETURN_ERROR
			break
		}

		# Check if this was the last poll
		if {$my_delay > $timeout} {
			log_error "Timeout"
			set rc $::RETURN_TIMEOUT
			break
		}
		set remamining_sec [expr $timeout - $my_delay]
		log_debug [format "Job in state/reason '%s' / '%s' instead of the desired '%s' / '%s'." \
		                  $job_state $job_reason \
		                  $desired_state $desired_reason_list]
		log_debug [format "Polling again in %ss, %ss to timeout." \
		                  $poll_interval $remamining_sec]

		sleep $poll_interval
		set my_delay [expr $my_delay + $poll_interval]
	}

	log_user $log_user_prev
	return $rc
}


################################################################
#
# NAME
#	get_config - returns a dictionary of slurm configuration parameters
#
# SYNOPSIS
#	get_config ?options?
#
# OPTIONS
#	-dbd
#		uses `sacctmgr show config` to return slurmdbd configuration
#		parameters
#	-slurm
#		uses `scontrol show config` to return slurm configuration
#		parameters (this is the default)
#
# RETURN VALUE
#	Returns a dictionary of parameter values
#
################################################################

proc get_config args {
	global sacctmgr scontrol

	set config_dict [list]
	set command "$scontrol"
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-slurm  {set command "$scontrol"; set args [lrange $args 1 end]}
			-dbd    {set command "$sacctmgr"; set args [lrange $args 1 end]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	if {[llength $args] > 0} {
		fail "[lindex [info level 0] 0]: No arguments allowed: $args"
	}

	set output [run_command_output -fail -nolog "$command show config"]

	foreach line [split $output "\n"] {
		if {[regexp {^(\S+) += (.*)$} $line {} param_name param_value] == 1} {
			dict set config_dict $param_name $param_value
		}
	}

	return $config_dict
}


################################################################
#
# NAME
#	get_config_param - returns a slurm configuration parameter value
#
# SYNOPSIS
#	get_config_param ?options? parameter_name
#
# OPTIONS
#	-dbd
#		uses `sacctmgr show config` to return the specified slurmdbd
#		configuration parameter value
#	-slurm
#		uses `scontrol show config` to return the specified slurm
#		configuration parameter value (this is the default)
#
# ARGUMENTS
#	parameter_name
#		the parameter to return the value for
#
# DESCRIPTION
#	Returns a specific configuration parameter value.
#
# RETURN VALUE
#	Returns the value of the specified parameter or MISSING if it does not
#	exist.
#
################################################################

proc get_config_param args {

	set options [list]
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-* {
				lappend options [lindex $args 0]
				set args [lrange $args 1 end]
			}
			default break
		}
	}
	if {[llength $args] == 1} {
		lassign $args parameter_name
	} else {
		fail "[lindex [info level 0] 0]: Invalid number of arguments ([llength $args]): $args"
	}

	set config_dict [get_config {*}$options]

	if [dict exists $config_dict $parameter_name] {
		return [dict get $config_dict $parameter_name]
	} else {
		return "MISSING"
	}
}


################################################################
#
# NAME
#	param_contains - test whether a comma-separated-list contains a specified value
#
# SYNOPSIS
#	param_contains haystack needle
#
# DESCRIPTION
#	Searches for the specified value (needle) in the comma-separated-list
#	string (haystack). Needle can be a glob-style pattern.
#
# RETURN VALUE
#	Returns a boolean value indicating whether the value (needle) was found
#	in the comma-separated-list string (haystack)
#
################################################################

proc param_contains { haystack needle } {
	if {[lsearch [split $haystack ","] $needle] != -1} {
		return true
	} else {
		return false
	}
}


################################################################
#
# NAME
#	param_value - returns the value of a parameter in a comma-separated-list
#
# SYNOPSIS
#	param_value params_list param ?default?
#
# DESCRIPTION
#	Searches for the specified param in the comma-separated-list
#	string (params_list) and returns its value.
#
# RETURN VALUE
#	Returns the value found or the optional default value if not found.
#	If the param is found without a value, returns true (ie like
#	param_contains).
#
################################################################

proc param_value {params_list param {default false}} {
	global re_word_str
	foreach pair [split $params_list ","] {
		if {[regexp "$param" $pair] == 1} {
			if {[regexp "$param=($re_word_str)" $pair - value] == 1} {
				return $value
			} else {
				return true
			}
		}
	}
	return $default
}


################################################################
#
# NAME
#	get_affinity_types - gets the task plugins running with task/ stripped
#
# SYNOPSIS
#	get_affinity_types
#
# RETURN VALUE
#	Returns comma separated list of task plugins running without the task/
#
################################################################

proc get_affinity_types { } {
	global scontrol re_word_str

	log_user 0
	set affinity ""
	spawn $scontrol show config
	expect {
		-re "TaskPlugin *= ($re_word_str)" {
			set parts [split $expect_out(1,string) ",/"]
			while 1 {
				set task_found [lsearch $parts "task"]
				if { $task_found == -1 } break
				set parts [lreplace $parts $task_found $task_found]
			}
			set affinity [join $parts ","]
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	return $affinity
}


################################################################
#
# NAME
#	get_mps_count_by_index - gets the count of a specific gres/mps device
#
# SYNOPSIS
#	get_mps_count_by_index index hostname
#
# RETURN VALUE
#	Returns the Count of a specific gres/mps device
#
################################################################

proc get_mps_count_by_index { index hostname } {
	global slurmd number re_word_str

	log_user 0
	set count 0
	spawn $slurmd -G -N $hostname
	expect {
		-re "Gres Name=mps Type=$re_word_str Count=($number) Index=$index" {
			set count $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	return $count
}

################################################################
#
# NAME
#	check_mpi - determines if mpicc and the desired --mpi option are available
#
# SYNOPSIS
#	check_mpi desired_mpi
#
# DESCRIPTION
#	Runs srun --mpi=list to determine if the desired mpi is available, as
#	well as if mpicc set in globals.local is too.
#
# RETURN VALUE
#	Returns true if the desired mpi and mpicc are available, false otherwise.
#
################################################################

proc check_mpi {desired_mpi} {
	global srun eol mpicc
	set output [run_command_output -fail "$srun --mpi=list"]

	return [regexp "${desired_mpi}${eol}" $output] && [file executable $mpicc]
}

################################################################
#
# NAME
#	check_influxdb_access - determines if user can access to the desired influxdb
#
# SYNOPSIS
#	check_influxdb_access host port database
#
# DESCRIPTION
#	It uses the global $influx CLI command to try to connect and use
#	the desired database.
#
# RETURN VALUE
#	Returns true if we can connect to host:port and use the database,
#	false otherwise
#
################################################################

proc check_influxdb_access {host port database} {
	global influx
	set connected 0
	set access 0

	if {![file executable $influx]} {
		log_warn "Cannot execute influx command: $influx"
		return false
	}

	set log_user_save [log_user -info]
	log_user 0
	spawn $influx -host $host -port $port
	expect {
		-re "Connected to" {
			set connected 1
			send "use $database\r"
			exp_continue
		}
		-re "Using database" {
			set access 1
			send "quit\r"
		}
		-re "unable to parse authentication credentials" {
			send "quit\r"
		}
		-re "authorization failed" {
			send "quit\r"
		}
		timeout {
			fail "InfluxDB instance not responding"
		}
		eof {
			wait
		}
	}
	log_user $log_user_save

	if {!$connected} {
		log_warn "Cannot connect to $host:$port"
		return false
	}
	if {!$access} {
		log_warn "Connected to $host:$port, but cannot use $database"
		return false
	}
	return true
}


################################################################
#
# NAME
#	check_bb_emulate - determines if Cray burst buffers API is emulated
#
# SYNOPSIS
#	check_bb_emulate
#
# RETURN VALUE
#	Returns true if Cray burst buffers API is emulated, false otherwise
#
################################################################

proc check_bb_emulate { } {
	global scontrol

	log_user 0
	set bb_emulate false
	spawn $scontrol show burst
	expect {
		-re "EmulateCray" {
			set bb_emulate true
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1
	return $bb_emulate
}


################################################################
#
# NAME
#	check_bb_persistent - determines if persistent burst buffers can be created by users
#
# SYNOPSIS
#	check_bb_persistent
#
# RETURN VALUE
#	Returns true if Cray burst buffers can be created by users,
#	false otherwise
#
################################################################

proc check_bb_persistent { } {
	global scontrol

	log_user 0
	set bb_persistent false
	spawn $scontrol show burst
	expect {
		-re "EnablePersistent" {
			set bb_persistent true
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1
	return $bb_persistent
}


################################################################
#
# NAME
#	get_default_acct - gets user's default account
#
# SYNOPSIS
#	get_default_acct user
#
# RETURN VALUE
#	Returns name of default account if exists, NULL otherwise
#
################################################################

proc get_default_acct { user } {
	global sacctmgr re_word_str bin_id

	log_user 0
	set def_acct ""

	if { !$user } {
		set user [get_my_user_name]
	}

	spawn $sacctmgr -n list -P user $user format="DefaultAccount"
	expect {
		-re "($re_word_str)" {
			set def_acct $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	return $def_acct
}


################################################################
#
# NAME
#	get_cycle_count - get desired iteration count
#
# SYNOPSIS
#	get_cycle_count
#
# DESCRIPTION
#	For tests with iteration counts (e.g. test9.1, test9.2)
#	return the desired iteration count
#
# RETURN VALUE
#	Returns desired iteration count
#
################################################################

proc get_cycle_count { } {
	global enable_memory_leak_debug

	if {$enable_memory_leak_debug != 0} {
		return 2
	}
	return 100
}


################################################################
#
# NAME
#	get_select_type_params - determines SelectTypeParameters being used for a given partition
#
# SYNOPSIS
#	get_select_type_params ?partition?
#
# DESCRIPTION
#	Determine SelectTypeParameters being used for a given partition.
#	If the partition is not specified, the default partition will be used.
#
# RETURN VALUE
#	Returns a string containing SelectTypeParameters
#
################################################################

proc get_select_type_params { {partition ""} } {
	global scontrol bin_bash bin_grep re_word_str

	log_user 0
	set params ""

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	if {$partition ne ""} {
		spawn -noecho $bin_bash -c "exec $scontrol show part $partition | $bin_grep SelectTypeParameters"
		expect {
			-re "SelectTypeParameters *= *NONE" {
				exp_continue
			}
			-re "SelectTypeParameters *= *($re_word_str)" {
				set params $expect_out(1,string)
				exp_continue
			}
			eof {
				wait
			}
		}
	}
	if {$params eq ""} {
		spawn -noecho $bin_bash -c "exec $scontrol show config | $bin_grep SelectTypeParameters"
		expect {
			-re "SelectTypeParameters *= *($re_word_str)" {
				set params $expect_out(1,string)
				exp_continue
			}
			eof {
				wait
			}
		}
	}
	log_user 1

	return $params
}


################################################################
#
# NAME
#	check_config_select - checks if effectively using the select type
#
# SYNOPSIS
#	check_config_select type
#
# DESCRIPTION
#	Determine if SelectType is equivalent to the passed type.
#
# ARGUMENTS
#	type
#		the desired SelectType to check (e.g. cons_tres)
#
# RETURN VALUE
#	Returns true if configured, false otherwise
#
################################################################

proc check_config_select { type } {
	set select_type [get_config_param "SelectType"]
	set select_type_parameters [get_config_param "SelectTypeParameters"]

	if {$select_type eq "select/$type"} {
		return true
	}

	return false
}


################################################################
#
# NAME
#	get_total_cpus - gets the total available CPUs on the default partition
#
# SYNOPSIS
#	get_total_cpus
#
# RETURN VALUE
#	The total available CPUs on the default partition.
#
# NOTE
#	CoreSpecCount are not part of the total.
#
################################################################

proc get_total_cpus {} {

	set total_cpu_count 0

	# Obtain the list of available nodes in the default partition
	set node_list [get_nodes_by_state]

	# Tally the cpus on these nodes
	set nodes_dict [get_nodes]
	foreach node_name $node_list {
		set node_dict [dict get $nodes_dict $node_name]
		set node_cpu_count [dict get $node_dict "CPUTot"]

		# Subtract out any spec cores
		if {[dict exists $node_dict "CoreSpecCount"] && [dict exists $node_dict "ThreadsPerCore"]} {
			set spec_cpu_count [expr [dict get $node_dict "CPUTot"] * [dict get $node_dict "ThreadsPerCore"]]
			incr node_cpu_count -$spec_cpu_count
		}

		incr total_cpu_count $node_cpu_count
	}

	return $total_cpu_count
}


################################################################
#
# NAME
#	is_running_in_container
#
# SYNOPSIS
#	is_running_in_container
#
# DESCRIPTION
#	Determine if test script is running inside of a container.
#
# RETURN VALUE
#	true if container detected or systemd-detect-virt is not found,
#	false otherwise
#
################################################################

proc is_running_in_container {} {
	global bin_systemd_detect_virt

	if {[run_command_status -nolog -none "$bin_systemd_detect_virt --version"]} {
		log_warn "$bin_systemd_detect_virt not found, assuming container"
		return true
	}

	set result [run_command -nolog -none "$bin_systemd_detect_virt -c"]
	set output [string trimright [dict get $result output] "\r\n"]
	if { $output != "none"} {
		log_debug "Detected container type: $output"
	}
	if {[dict get $result exit_code]} {
		return false
	}
	return true
}

################################################################
#
# NAME
#	is_super_user - determines if user is root or SlurmUser
#
# SYNOPSIS
#	is_super_user ?user?
#
# DESCRIPTION
#	Determine if user is a Slurm super user (i.e. user
#	root or configured SlurmUser)
#
# RETURN VALUE
#	true is user is root or SlurmUser, false otherwise
#
################################################################

proc is_super_user {{user ""}} {
	global number

	if {$user == ""} {
		set user [get_my_user_name]
	}

	# Check if user is root
	if {$user eq "root"} {
		return true
	}

	# Check if user is SlurmUser
	set slurm_user [get_config_param "SlurmUser"]
	if {[regexp "${user}\\($number\\)" $slurm_user match]} {
		return true
	}

	return false
}


################################################################
#
# NAME
#	dec2hex - creates a 32 bit hex number from a signed decimal number
#
# SYNOPSIS
#	dec2hex value
#
# DESCRIPTION
#	Create a 32 bit hex number from a signed decimal number
#
# RETURN VALUE
#	32 bit hex version of input 'value'
#
# SOURCE
#	Courtesy of Chris Cornish
#	http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/415982
#
################################################################
# Replace all non-decimal characters

proc dec2hex {value} {
	regsub -all {[^0-x\.-]} $value {} newtemp
	set value [string trim $newtemp]
	if {$value < 2147483647 && $value > -2147483648} {
		set tempvalue [format "%#010X" [expr $value]]
		return [string range $tempvalue 2 9]
	} elseif {$value < -2147483647} {
		return "80000000"
	} else {
		return "7FFFFFFF"
	}
}


################################################################
#
# NAME
#	uint2hex - creates a 32 bit hex number from an unsigned decimal
#
# SYNOPSIS
#	uint2hex value
#
# DESCRIPTION
#	Create a 32 bit hex number from an unsigned decimal number.
#
# ARGUMENTS
#	value
#		unsigneddecimal number to convert
#
# RETURN VALUE
#	32 bit hex version of input 'value'
#
# SOURCE
#	Courtesy of Chris Cornish
#	http://aspn.activestate.com/ASPN/Cookbook/Tcl/Recipe/415982
#
################################################################
# Replace all non-decimal characters

proc uint2hex {value} {
	regsub -all {[^0-x\.-]} $value {} newtemp
	set value [string trim $newtemp]
	if {$value <= 4294967295 && $value >= 0} {
		set tempvalue [format "%#010X" [expr $value]]
		return [string range $tempvalue 2 9]
	} else {
		return "FFFFFFFF"
	}
}


################################################################
#
# NAME
#	partition_oversubscribe - determines the oversubscribe configuration of the specified partition
#
# SYNOPSIS
#	partition_oversubscribe ?partition?
#
# DESCRIPTION
#	Determine the oversubscribe configuration of the specified partition.
#	If the partition is not specified, the default partition will be used.
#
# RETURN VALUE
#	Return the oversubscribe configuration of the specified partition.
#
################################################################

proc partition_oversubscribe { {partition ""} } {
	global sinfo

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	set oversubscribe "NO"
	log_debug "$sinfo --noheader --partition $partition --format %h"
	set fd [open "|$sinfo --noheader --partition $partition --format %h"]
	gets $fd line
	catch {close $fd}
	regexp {[a-zA-Z]+} $line oversubscribe
	return $oversubscribe
}


################################################################
#
# NAME
#	default_partition - determines the name of the default partition
#
# SYNOPSIS
#	default_partition
#
# DESCRIPTION
#	Use scontrol to determine the name of the default partition
#
# RETURN VALUE
#	Name of the current default partition, or fail if not found.
#
################################################################

proc default_partition {} {
	global scontrol

	set name ""
	set fd [open "|$scontrol --all --oneliner show partition"]
	while {[gets $fd line] != -1} {
		if {[regexp {^PartitionName=([^ ]*).*Default=YES} $line frag name]
				== 1} {
			break
		}
	}
	catch {close $fd}

	if {[string length $name] == 0} {
		fail "Could not identify the default partition"
	}

	return $name
}


################################################################
#
# NAME
#	default_part_exclusive - determines if the default partition allocates whole nodes to jobs
#
# SYNOPSIS
#	default_part_exclusive
#
# DESCRIPTION
#	Use scontrol to determine if the default partition
#	allocates whole nodes to jobs
#
# RETURN VALUE
#	Name of the current default partition
#
################################################################

proc default_part_exclusive {} {
	set def_part [default_partition]
	set oversubscribe [partition_oversubscribe $def_part]
	if {$oversubscribe eq "EXCLUSIVE"} {
		return 1
	} else {
		return 0
	}
}


################################################################
#
# NAME
#	make_bash_script - creates a bash script
#
# SYNOPSIS
#	make_bash_script script_name script_contents
#
# DESCRIPTION
#	Create a bash script of name "script_name", and
#	make the body of the script "script_contents".
#	make_bash_script removes the file if it already exists,
#	then generates the #! line, and then dumps "script_contents"
#	to the file.  Finally, it makes certain that the script
#	is executable.
#
# ARGUMENTS
#	script_name
#		file name for the bash script
#	script_contents
#		body of the script, not including the initial #! line.
#
# RETURN VALUE
#	Nothing.
#
################################################################

proc make_bash_script { script_name script_contents } {
	global bin_bash bin_chmod

	file delete $script_name
	set fd [open $script_name "w"]
	puts $fd "#!$bin_bash"
	puts $fd $script_contents
	close $fd
	exec $bin_chmod 777 $script_name
}


################################################################
#
# NAME
#	check_acct_associations - checks associations
#
# SYNOPSIS
#	check_acct_associations
#
# DESCRIPTION
#	Use sacctmgr to check associations
#
# RETURN VALUE
#	true if no error is found, false otherwise
#
################################################################

proc check_acct_associations { } {
	global sacctmgr number re_word_str

	# 2 versions after 23.11 we can remove the below function
	# until then we should check older clusters lft/rgt
	set rc [check_acct_associations_lft]

	if { !$rc } {
		return $rc;
	}

	log_user 0
	log_debug "Sanity-Checking Associations"
	#
	# Use sacctmgr to check associations
	#
	spawn $sacctmgr -n -p list assoc wopi wopl withd format=lineage,cluster
	expect {
	       -re "($re_word_str)\\|($re_word_str)\\|" {
		      # Here we are checking if we have duplicates and
		      # setting up an array to check for holes later

		      set lineage $expect_out(1,string)
		      set cluster $expect_out(2,string)
		      set first [info exists found($cluster,$lineage)]

		      if { $first } {
			     log_error "$cluster found lineage $lineage again"
			     set rc false
		      } else {
			     set found($cluster,$lineage) 1
		      }
		      exp_continue
	       }
	       timeout {
			fail "sacctmgr add not responding"
	       }
	       eof {
		      wait
	       }
	}

	log_user 1
	return $rc
}

proc check_acct_associations_lft { } {
	global sacctmgr number re_word_str

	set rc true
	log_user 0

	log_debug "Sanity-Checking Associations"

	set clusters ""

	spawn $sacctmgr show cluster format=cluster,rpc -p
	expect {
		-re "($re_word_str)\\|($number)\\|" {
			# 9984 == 23.02, the last version where lft/rgt matter
			if { $expect_out(2,string) > 9984 } {
				exp_continue
			}
			set clusters [ concat $clusters "," $expect_out(1,string) ]
			exp_continue
		}
	}

	#
	# Use sacctmgr to check associations
	#
	spawn $sacctmgr -n -p list assoc wopi wopl withd format=lft,rgt,cluster clusters="$clusters"
	expect {
	       -re "($number)\\|($number)\\|($re_word_str)\\|" {
		      # Here we are checking if we have duplicates and
		      # setting up an array to check for holes later

		      set cluster $expect_out(3,string)
		      if { ![info exists c_min($cluster)] } {
			      set c_min($cluster) -1
			      set c_max($cluster) -1
		      }

		      set num1 $expect_out(1,string)
		      set num2 $expect_out(2,string)
		      set first [info exists found($cluster,$num1)]
		      set sec [info exists found($cluster,$num2)]
		      #log_debug "$first=$num1 $sec=$num2"
		      if { $first } {
			     log_error "$cluster found lft $num1 again"
			     set rc false
		      } elseif { $sec } {
			     log_error "$cluster found rgt $num2 again"
			     set rc false
		      } else {
			     set found($cluster,$num1) 1
			     set found($cluster,$num2) 1
			     if { $c_min($cluster) == -1
				  || $c_min($cluster) > $num1 } {
				    set c_min($cluster) $num1
			     }
			     if { $c_max($cluster) == -1
				  || $c_max($cluster) < $num2 } {
				    set c_max($cluster) $num2
			     }
		      }
		      exp_continue
	       }
	       timeout {
			fail "sacctmgr add not responding"
	       }
	       eof {
		      wait
	       }
	}

	foreach cluster [array names c_min] {
		# Here we are checking for holes in the list from above
		for {set inx $c_min($cluster)} {$inx < $c_max($cluster)} {incr inx} {
			if { ![info exists found($cluster,$inx)] } {
				log_error "$cluster No index at $inx"
				set rc false
			}
		}
	}
	log_user 1
	return $rc
}

################################################################
#
# NAME
#	get_job_acct_freq - gets the value of the job account gather frequency
#
# SYNOPSIS
#	get_job_acct_freq
#
# RETURN VALUE
#	job account gather frequency
#
################################################################

proc get_job_acct_freq { } {
	global scontrol number

	log_user 0
	set freq_val 0

	spawn $scontrol show config
	expect {
		-re "JobAcctGatherFrequency *= ($number)" {
			set freq_val $expect_out(1,string)
			if {$freq_val == 0} {
				set freq_val 0
			}
		}
		-re "JobAcctGatherFrequency *= task=($number)" {
			set freq_val $expect_out(1,string)
			if {$freq_val == 0} {
				set freq_val 0
			}
		}
		eof {
			wait
		}
	}

	log_user 1
	return $freq_val
}


################################################################
#
# NAME
#	get_admin_level - gets the AdminLevel of the user
#
# SYNOPSIS
#	get_admin_level ?user?
#
# RETURN VALUE
#	AdminLevel for the current user
#
################################################################

proc get_admin_level {{user_name ""}} {
	global sacctmgr re_word_str re_word_str bin_id

	set admin_level ""

	if {$user_name == ""} {
		set user_name [get_my_user_name]
		if { ![string length $user_name] } {
			log_error "No name returned from id"
			return ""
		}
	}

	if {[is_super_user $user_name]} {
		return "Administrator"
	}

	#
	# Use sacctmgr to check admin_level
	#
	log_user 0
	spawn $sacctmgr -n -P list user $user_name format=admin
	expect {
		-re "($re_word_str)" {
		      set admin_level $expect_out(1,string)
		      exp_continue
	       }
	       timeout {
		      fail "sacctmgr add not responding"
	       }
	       eof {
		      wait
	       }
	}
	log_user 1

	return $admin_level
}


#################################################
#
# NAME
#	scale_to_megs - scales the value by the factor T|G|M to megabytes
#
# SYNOPSIS
#	scale_to_megs value factor
#
# DESCRIPTION
#	scale the value by the factor T|G|M to megabytes
#
# RETURN VALUE
#	the scaled variable
#
#################################################

proc scale_to_megs { value factor } {

	if {$factor == "T"} {
		set value [expr $value * 1024 * 1024]
	} elseif {$factor == "G"} {
		set value [expr $value * 1024]
	} elseif {$factor == "M"} {
		set value [expr $value * 1]
	} elseif {$factor == "K"} {
		set value [expr $value / 1024]
		set value [expr {round($value)}]
	} else {
		set value [expr $value / (1024 * 1024)]
		set value [expr {round($value)}]
	}

	return $value
}


#################################################
#
# NAME
#	scale_to_ks - scales the value by the factor G|M|K to kilobytes
#
# SYNOPSIS
#	scale_to_ks value factor
#
# DESCRIPTION
#	scale the value by the factor G|M|K to kilobytes
#
# RETURN VALUE
#	the scaled variable
#
#################################################

proc scale_to_ks { value factor } {

	if {$factor == "G"} {
		set value [expr $value * 1024 * 1024]
	} elseif {$factor == "M"} {
		set value [expr $value * 1024]
	} elseif {$factor == "K"} {
		set value [expr $value * 1]
	} else {
		set value [expr $value / 1024]
		set value [expr {round($value)}]
	}

	return $value
}


############################################################
#
# NAME
#	check_config_node_mem - checks that the nodes have memory configured
#
# SYNOPSIS
#	check_config_node_mem
#
# RETURN VALUE
#	true if all nodes have memory, false otherwise
#
############################################################

proc check_config_node_mem { } {

	set nodes_dict [get_nodes]
	dict for {node_name node_dict} $nodes_dict {
		if [dict exists $node_dict "RealMemory"] {
			if {[dict get $node_dict "RealMemory"] == 1} {
				return false
			}
		} else {
			log_warn "Parameter RealMemory not found on node $node_name"
			return false
		}
	}

	return true
}


################################################################
#
# NAME
#	wait_for_node - waits for nodes in a partition to reach a certain state
#
# SYNOPSIS
#	wait_for_node ?options? state num_nodes ?partition?
#
# DESCRIPTION
#	Wait for a certain number of nodes in a partition to reach a certain
#	state.
#
# OPTIONS
#	-timeout <integer_number>
#		time in seconds to wait for the node state before
#		timing out (default is 3)
#	-pollinterval <integer_number>
#		time in seconds between each node state check (default is 1)
#
# ARGUMENTS
#	state
#		The node state to wait for
#	num_nodes
#		The number of nodes we want to be in the specified state
#	partition
#		Partition name (the default partition is used if not specified)
#
# RETURN VALUE
#	RETURN_SUCCESS, or non-zero on failure
#
################################################################

proc wait_for_node args {
	global sinfo number

	set partition     ""
	set timeout       3
	set poll_interval 1
	set desired_state "PENDING"
	set desired_reason_list ""
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-time*  {set args [lassign $args - timeout]}
			-poll*  {set args [lassign $args - poll_interval]}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count < 2} {
		fail "Too few arguments ($argument_count): $args"
	} else {
		lassign $args state num_nodes
	}
	if {$argument_count == 3} { set partition [lindex $args 2] }
	if {$argument_count > 3} {
		fail "Too many arguments ($argument_count): $args"
	}

	set wait_time 0
	set done      0
	set cnt       0
	set rt        $::RETURN_SUCCESS

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	while {$done != 1 && $wait_time < $timeout} {
		set output [run_command_output -fail "$sinfo --noheader --partition $partition --state $state --format %D"]
		regexp "$number" $output cnt

		if {$num_nodes <= $cnt} {
			set done 1
		} else {
			log_debug "Partition $partition has $cnt nodes idle and we want $num_nodes"
			sleep $poll_interval
			incr wait_time 1
		}
	}
	if {$done != 1} {
		set rt $::RETURN_ERROR
	}

	return $rt
}


#####################################################################
#
# NAME
#	node_list_to_range - converts a TCL list into a Slurm hostlist using scontrol
#
# SYNOPSIS
#	node_list_to_range nodes_list
#
# ARGUMENTS
#
#	nodes_list
#		a TCL list of node names
#
# RETURN VALUE
#	the hostlist form returned by scrontrol show hostlist
#
#####################################################################

proc node_list_to_range {nodes_list} {
	global scontrol

	set comalist [join $nodes_list ,]
	set hostlist [run_command_output -nolog -fail "$scontrol show hostlist $comalist"]
	set hostlist [string trimright $hostlist "\r\n"]
}


################################################################
#
# NAME
#	list_to_range - converts a list of integer numbers to a range expression
#
# SYNOPSIS
#	list_to_range ?numeric_list?
#
# DESCRIPTION
#	Collapse a numeric list to a range expression defined by the following
#	EBNF:
#		<expression> ::= <range> {, <range>}*
#		<range> ::= <integer> - <integer> | <integer>
#
# RETURN VALUE
#	a range expression representing the numeric elements on the given list.
#
################################################################

proc list_to_range {numeric_list} {
	set node_range_expression [node_list_to_range $numeric_list]
	set range_expression [regsub {^\[(.*)\]$} $node_range_expression {\1}]
	return $range_expression
}


#####################################################################
#
# NAME
#	node_range_to_list - converts a node range expression into a list of nodes using scontrol
#
# SYNOPSIS
#	node_range_to_list node_range_expression
#
# ARGUMENTS
#
#	node_range_expression
#		a node range expression accepted by scontrol
#
# RETURN VALUE
#	a list contining all node names expanded from the node range expression
#
#####################################################################

proc node_range_to_list {node_range_expression} {
	global scontrol

	set node_list [list]
	set output [run_command_output -nolog -fail "$scontrol show hostnames $node_range_expression"]
	foreach line [split $output "\n"] {
		if {$line eq ""} {
			break
		}
		lappend node_list $line
	}
	return $node_list
}


################################################################
#
# NAME
#	range_to_list - converts a range expression into a list with the numbers of the range
#
# SYNOPSIS
#	range_to_list ?range_expression?
#
# DESCRIPTION
#	Expands a range expression defined by the following EBNF into a numeric list
#		<expression> ::= <range> {, <range>}*
#		<range> ::= <integer> - <integer> | <integer>
#
# RETURN VALUE
#	Returns the list of integer numbers defined by the range_expression
#
################################################################

proc range_to_list {range_expression} {
	set node_range_expression \[$range_expression\]
	set range_list [node_range_to_list $node_range_expression]
	return $range_list
}


#####################################################################
#
# NAME
#	get_nodes_by_state - gets the list of node names in a given partition/states
#
# SYNOPSIS
#	get_nodes_by_state partition states
#
# DESCRIPTION
#	sinfo is used to list node names and states in the specified partition.
#	This list of nodes is filtered to return only the nodes matching one of
#	the requested states.
#
# ARGUMENTS
#	partition
#		partition to get nodes off
#	states
#		comma-separated list of allowed states
#
# RETURN VALUE
#	list of nodes having the required state
#
#####################################################################

proc get_nodes_by_state {{states ""} {partition ""}} {
	global sinfo

	set node_list [list]

	if {$partition eq ""} {
		set partition [default_partition]
	}

	if {$states eq ""} {
		set states "idle"
	}

	set output [run_command_output -fail "$sinfo -h -N -p $partition -o '%N' -e -t $states"]
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }
		lappend node_list $line
	}

	return $node_list
}


#####################################################################
#
# NAME
#	set_partition_maximum_time_limit - sets the maximum time limit in a given partition
#
# SYNOPSIS
#	set_partition_maximum_time_limit partition limit
#
# RETURN VALUE
#	RETURN_SUCCESS, or non-zero on error
#
#####################################################################

proc set_partition_maximum_time_limit {partition limit} {
	global scontrol

	if {[string length $partition] == 0} {
		set partition [default_partition]
		if { $partition == "" } {
			return $::RETURN_ERROR
		}
	}

	if { $limit < -1 } {
		fail "Trying to set invalid partition time limit of $limit"
	}
	if { $limit == -1 } {
		set expected_lim "UNLIMITED"
	} else {
		set expected_lim limit
	}

	run_command -fail "$scontrol update partitionname=$partition MaxTime=-1"

	set maxtime [get_partition_maximum_time_limit $partition]
	if { $maxtime != $limit } {
		log_error "Unable to update partition MaxTime, got $maxtime, wanted $limit"
		return $::RETURN_ERROR
	}

	return $::RETURN_SUCCESS
}


#####################################################################
#
# NAME
#	get_partition_maximum_time_limit - gets the maximum time limit in a given partition
#
# SYNOPSIS
#	get_partition_maximum_time_limit partition
#
# DESCRIPTION
#	Get the maximum time limit in a given partition
#
# RETURN VALUE
#	time limit in seconds, -1 if undefined or error
#
#####################################################################

proc get_partition_maximum_time_limit {partition} {
	global sinfo number

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	set secs 0
	log_user 0
	spawn -noecho $sinfo -h -p $partition -O time -e
	expect {
		-re "infinite" {
			set secs -1
			exp_continue
		}
		-re "n/a" {
			set secs -1
			exp_continue
		}
		-re "($number)-($number):($number):($number)" {
			set days  [expr $expect_out(1,string) * 24 * 60 * 60]
			set hours [expr $expect_out(2,string) * 60 * 60]
			set mins  [expr $expect_out(3,string) * 60]
			set secs  [expr $days + $hours + $mins + $expect_out(4,string)]
			exp_continue
		}
		-re "($number):($number):($number)" {
			set hours [expr $expect_out(1,string) * 60 * 60]
			set mins  [expr $expect_out(2,string) * 60]
			set secs  [expr $hours + $mins + $expect_out(3,string)]
			exp_continue
		}
		-re "($number):($number)" {
			set mins  [expr $expect_out(1,string) * 60]
			set secs  [expr $mins + $expect_out(2,string)]
			exp_continue
		}
		-re "($number)" {
			set secs  [expr $expect_out(1,string) * 60]
			exp_continue
		}
		timeout {
			fail "sinfo not responding"
		}
		eof {
			wait
		}
	}

	log_user 1
	return $secs
}


################################################################
#
# NAME
#	get_partition_default_time_limit - gets the default time limit in a given partition
#
# SYNOPSIS
#	get_partition_default_time_limit ?partition?
#
# DESCRIPTION
#	Get the default time limit in a given partition.
#	If the partition is not specified, the default partition will be used.
#
# RETURN VALUE
#	Returns: time limit in seconds, -1 if undefined or error.
#
################################################################

proc get_partition_default_time_limit { {partition ""} } {
	global sinfo number

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	set secs 0
	log_user 0
	spawn -noecho $sinfo -h -p $partition -O defaulttime -e
	expect {
		-re "infinite" {
			set secs -1
			exp_continue
		}
		-re "n/a" {
			set secs -1
			exp_continue
		}
		-re "($number)-($number):($number):($number)" {
			set days  [expr $expect_out(1,string) * 24 * 60 * 60]
			set hours [expr $expect_out(2,string) * 60 * 60]
			set mins  [expr $expect_out(3,string) * 60]
			set secs  [expr $days + $hours + $mins + $expect_out(4,string)]
			exp_continue
		}
		-re "($number):($number):($number)" {
			set hours [expr $expect_out(1,string) * 60 * 60]
			set mins  [expr $expect_out(2,string) * 60]
			set secs  [expr $hours + $mins + $expect_out(3,string)]
			exp_continue
		}
		-re "($number):($number)" {
			set mins  [expr $expect_out(1,string) * 60]
			set secs  [expr $mins + $expect_out(2,string)]
			exp_continue
		}
		-re "($number)" {
			set secs  [expr $expect_out(1,string) * 60]
			exp_continue
		}
		timeout {
			fail "sinfo not responding"
		}
		eof {
			wait
		}
	}

	log_user 1
	return $secs
}


#####################################################################
#
# NAME
#	get_node_cores - given a node, returns its total number of cores
#
# SYNOPSIS
#	get_node_cores node
#
# DESCRIPTION
#	Given a node, return its total number of cores
#	(not the CoresPerSocket, but the total cores)
#
# RETURN VALUE
#	node cores if retrieved, -1 otherwise
#
#####################################################################

proc get_node_cores {node} {
	global sinfo number

	set cores -1
	set sockets_per_node 0
	set cores_per_socket 0

	if {[string length $node] == 0} {
		return $cores
	}

	log_user 0
	spawn -noecho $sinfo -o "%X %Y" -h -n $node
	expect {
		-re "($number)" {
			if {$sockets_per_node == 0} {
				set sockets_per_node $expect_out(1,string)
			} else {
				set cores_per_socket $expect_out(1,string)
			}
			exp_continue
		}
		timeout {
			fail "sinfo not responding"
		}
		eof {
			wait
		}
	}
	log_user 1

	set cores [expr $sockets_per_node * $cores_per_socket]

	return $cores
}


#####################################################################
#
# NAME
#	get_node_cpus - given a node, returns its total number of threads we account for
#
# SYNOPSIS
#	get_node_cpus node
#
# DESCRIPTION
#	Given a node, return its total number of threads we account for.
#	(not always ThreadsPerCore, but how many threads are in use.
#	i.e. CPUs=6 CoresPerSocket=6 ThreadsPerCore=2 Socket=1 would
#	result in only 1 thread we care about instead of the 2 listed.)
#
# RETURN VALUE
#	list of node [ tot_cpus threads ] if retrieved, [ -1 -1 ] otherwise
#
#####################################################################

proc get_node_cpus {node} {
	global scontrol number

	set nthreads -1
	set nsockets 0
	set ncores 0
	set totcpus -1

	if {[string length $node] == 0} {
		return [list $totcpus $nthreads]
	}

	# Get the number of CPUs on a node
	spawn $scontrol show node $node
	expect {
		-re "CoresPerSocket=($number)" {
			set ncores $expect_out(1,string)
			exp_continue
		}
		-re "CPUTot=($number)" {
			set totcpus $expect_out(1,string)
			exp_continue
		}
		-re "Sockets=($number)" {
			set nsockets $expect_out(1,string)
			exp_continue
		}
		-re "ThreadsPerCore=($number)" {
			set nthreads $expect_out(1,string)
			exp_continue
		}
		timeout {
			fail "scontrol is not responding"
		}
		eof {
			wait
		}
	}

	set core_cnt [expr $nsockets * $ncores]
	set thread_cnt [expr $ncores * $nthreads]
	if {$totcpus != $nthreads && $totcpus == $ncores} {
		log_debug "Cores rather than threads are being allocated"
		set nthreads 1
	}

	return [list $totcpus $nthreads]
}


#####################################################################
#
# NAME
#	get_part_total_cores - given a partition and/or states, return its total cores
#
# SYNOPSIS
#	get_part_total_cores partition states
#
# DESCRIPTION
#	Given a partition and/or states, return its total cores
#
# ARGUMENTS
#	partition
#		partition to check cores
#	states
#		states to filter on partition cores
#
# RETURN VALUE
#	partition cores
#
#####################################################################

proc get_part_total_cores {part states} {
	global sinfo number

	set cores 0
	set tmp 0
	set i 0

	if {[string length $part] == 0} {
		set part [default_partition]
	}

	log_user 0
	if {[string length $states] == 0} {
		spawn -noecho $sinfo -h -N -p $part -o "%X %Y"
	} else {
		spawn -noecho $sinfo -h -N -p $part -t $states -o "%X %Y"
	}
	expect {
		-re "($number)" {
			set is_even [expr {($i % 2) == 0}]
			if {$is_even == 1} {
				set tmp $expect_out(1,string)
			} else {
				set tmp [expr $tmp * $expect_out(1,string)]
				set cores [expr $cores + $tmp]
			}
			incr i
			exp_continue
		}
		timeout {
			fail "sinfo not responding"
		}
		eof {
			wait
		}
	}
	log_user 1

	return $cores
}


#####################################################################
#
# NAME
#	check_hosts_contiguous - verify if all hosts belong to the partition and are contiguous
#
# SYNOPSIS
#	check_hosts_contiguous check_hosts_list partition
#
# DESCRIPTION
#	Given a partition and a list of hosts, verify if all
#	hosts belong to the partition and are contiguous.
#	If the partition argument is empty, the default partition
#	will be used.
#
# RETURN VALUE
#	Returns: true if hosts are contiguous, false otherwise.
#
#####################################################################

proc check_hosts_contiguous { check_hosts_list {partition ""} } {
	global sinfo re_word_str

	if {[string length $partition] == 0} {
		set partition [default_partition]
	}

	set part_hosts_list {}

	log_user 0
	spawn $sinfo --noheader -p $partition -N -o %N
	expect {
		-re "($re_word_str)" {
			lappend part_hosts_list $expect_out(1,string)
			exp_continue
		}
		-re "Unable to contact" {
			fail "Slurm appears to be down"
		}
		timeout {
			fail "sinfo not responding"
		}
		eof {
			wait
		}
	}
	log_user 1

	foreach host $check_hosts_list {
		set idx_cur [lsearch $part_hosts_list $host]
		if {$idx_cur == -1} {
			fail "Host ($host) not found in list of hosts from partition $partition"
		}
		if {[info exists idx_old]} {
			if {$idx_cur != [expr $idx_old + 1]} {
				log_error "Node sequence number not contiguous"
				return false
			}
		}
		set idx_old $idx_cur
	}

	return true
}


################################################################
#
# NAME
#	get_het_job_ids - gets list of component job ids for a het job
#
# SYNOPSIS
#	get_het_job_ids job_id ?use_offset?
#
# DESCRIPTION
#	Gets list of component job ids for a het job.
#
# ARGUMENTS
#	job_id
#		Slurm job id
#	use_offset
#		If zero, returns list of integer job ids, else returns ids in
#		the form of X+Y where X is het job master id and Y is the
#		offset.
#
# RETURN VALUE
#	A list of ids for a hetjob or an empty list if jobid
#	is not a het one.
#
################################################################

proc get_het_job_ids { jobid {use_offset 0}} {
	global scontrol number

	set id_list ""
	set log_user_save [log_user -info]
	log_user 0
	spawn $scontrol show job $jobid
	expect {
		-re "JobId=($number) HetJobId=($number) HetJobOffset=($number)" {
			if { $use_offset } {
				lappend id_list "$expect_out(2,string)+$expect_out(3,string)"
			} else {
				lappend id_list $expect_out(1,string)
			}
			exp_continue
		}
		timeout {
			fail "scontrol not responding"
		}
		eof {
			wait
		}
	}
	log_user $log_user_save
	return $id_list
}


################################################################
#
# NAME
#	reconfigure - calls scontrol reconfigure
#
# SYNOPSIS
#	reconfigure ?options? ?cluster?
#
# DESCRIPTION
#	Calls scontrol reconfigure. This routine takes the same options as
#	run_command, passing them to the underlying run_command invocation.
#	This command waits an additional 5 seconds before returning.
#
# OPTIONS
#	See OPTIONS of run_command proc.
#
# ARGUMENTS
#	cluster
#		The cluster to reconfigure
#
# RETURN VALUE
#	RETURN_SUCCESS on success, otherwise RETURN_ERROR
#
################################################################

proc reconfigure args {
	global scontrol

	set options [list]
	set cluster ""

	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-* {
				lappend options {*}[lrange $args 0 1]
				set args [lrange $args 2 end]
			}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count > 1}  {
		fail "Too many arguments ($argument_count): $args"
	} elseif {$argument_count == 1} {
		lassign $args cluster
	}

	set command $scontrol
	if {$cluster ne ""} {
		append command " -M$cluster"
	}
	append command " reconfigure"
	set rc [run_command_status {*}$options "$command"]

	#
	# Wait 5 seconds for reconfigure to complete, then return.
	#
	sleep 5
	return $rc
}


#####################################################################
#
# NAME
#	log_fatal - prints a fatal message
#
# SYNOPSIS
#	log_fatal message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_fatal {message} {
	global testsuite_log_level LOG_LEVEL_FATAL

	if {$testsuite_log_level >= $LOG_LEVEL_FATAL} {
		_log_format "fatal" "$message"
	}
}


#####################################################################
#
# NAME
#	log_error - prints an error message
#
# SYNOPSIS
#	log_error message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_error {message} {
	global testsuite_log_level LOG_LEVEL_ERROR

	if {$testsuite_log_level >= $LOG_LEVEL_ERROR} {
		_log_format "error" "$message"
	}
}


#####################################################################
#
# NAME
#	log_warn - prints a warning message
#
# SYNOPSIS
#	log_warn message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_warn {message} {
	global testsuite_log_level LOG_LEVEL_WARNING

	if {$testsuite_log_level >= $LOG_LEVEL_WARNING} {
		_log_format "warning" "$message"
	}
}


#####################################################################
#
# NAME
#	log_info - prints an information message
#
# SYNOPSIS
#	log_info message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_info {message} {
	global testsuite_log_level LOG_LEVEL_INFO

	if {$testsuite_log_level >= $LOG_LEVEL_INFO} {
		_log_format "info" "$message"
	}
}


#####################################################################
#
# NAME
#	log_pass - prints a pass level message
#
# SYNOPSIS
#	log_pass message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_pass {message} {
	global testsuite_log_level LOG_LEVEL_PASS

	if {$testsuite_log_level >= $LOG_LEVEL_PASS} {
		_log_format "pass" "$message"
	}
}


#####################################################################
#
# NAME
#	log_command - prints a command level message
#
# SYNOPSIS
#	log_command message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_command {message} {
	global testsuite_log_level LOG_LEVEL_COMMAND

	if {$testsuite_log_level >= $LOG_LEVEL_COMMAND} {
		_log_format "command" "$message"
	}
}


#####################################################################
#
# NAME
#	log_debug - prints a debug level message
#
# SYNOPSIS
#	log_debug message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_debug {message} {
	global testsuite_log_level LOG_LEVEL_DEBUG

	if {$testsuite_log_level >= $LOG_LEVEL_DEBUG} {
		_log_format "debug" "$message"
	}
}


#####################################################################
#
# NAME
#	log_trace - prints a trace level message
#
# SYNOPSIS
#	log_trace message
#
# SEE ALSO
#	_log_format for options governing the message format and colorization
#
#####################################################################

proc log_trace {message} {
	global testsuite_log_level LOG_LEVEL_TRACE

	if {$testsuite_log_level >= $LOG_LEVEL_TRACE} {
		_log_format "trace" "$message"
	}
}


################################################################
#
# NAME
#	in_fed - checks whether this cluster is in a federation
#
# SYNOPSIS
#	in_fed
#
# RETURN VALUE
#	Returns true if this cluster is in a federation, false otherwise
#
################################################################

proc in_fed {} {
	global scontrol

	set output [run_command_output -fail -nolog "$scontrol show fed"]
	if {[regexp "Federation" $output]} {
		return true
	}

	return false
}


################################################################
#
# NAME
#	check_job_state - checks if the state of a job is the expected one
#
# SYNOPSIS
#	check_job_state job state ?het_job?
#
# DESCRIPTION
#	Checks if the state of a job is the expected one.
#
# ARGUMENTS
#	job
#		Job ID to check
#	state
#		Desired state of the job to match
#	het_job
#		If set, checks state of each component job if the
#		job is a hetjob.
#
# RETURN VALUE
#	true if job was on the desired state, or the number of job components
#	on that state if it's a hetjob and het_job option enabled, false
#	otherwise.
#
################################################################

proc check_job_state { job state {het_job 0}} {
	global scontrol

	set jid_list ""
	if { $het_job } {
		set jid_list [get_het_job_ids $job 1]
	}

	if { $jid_list == "" } {
		# non-het job
		set jid_list $job
	}

	foreach jid $jid_list {
		set state_match 0
		spawn $scontrol show job $jid
		expect {
			-re "JobState=($state)" {
				incr state_match
			}
			timeout {
				fail "scontrol not responding"
			}
			eof {
				wait
			}
		}

		if {$state_match != 1} {
			log_error "job $jid should be in $state state, but is not"
			return false
		}
	}

	return true
}


################################################################
#
# NAME
#	get_gres_count - returns a dict of nodes and GRES counts
#
# SYNOPSIS
#	get_gres_count gres_name ?node_list?
#
# DESCRIPTION
#	Returns a dict of node names and the count of a specifed
#	GRES aggregating all its types on each node.
#
# RETURN VALUE
#	If the node_list is not specified node name is specified,
#	this function will return a dict with the GRES count for all
#	the nodes of the default partition.
#	If specified, a dict only with the nodes of the node_list.
#
################################################################

proc get_gres_count { gres_name {node_list ""} } {
	set nodes_dict [get_nodes $node_list]
	set nodes_gres_dict [dict create]
	dict for {node_name node_dict} $nodes_dict {
		if [dict exists $node_dict "Gres"] {
			set gres_param [dict get $node_dict "Gres"]
			set gres_dict  [count_gres $gres_param]
		}
		if [dict exists $gres_dict $gres_name] {
			set gres_count [dict get $gres_dict $gres_name]
			dict set nodes_gres_dict $node_name $gres_count
		}
	}
	return $nodes_gres_dict
}


################################################################
#
# NAME
#	count_gres - returns a dict of GRES names and their total counts
#
# SYNOPSIS
#	count_gres gres_param
#
# DESCRIPTION
#	Parses a GRES parameter string typically obtained from nodes or
#	jobs info, and returns a dict of GRES names and their count
#	aggregating all the types of each GRES.
#
# ARGUMENTS
#	gres_param
#		The usual coma-separated list of Gres (e.g gpu:2,craynetwork:1).
#	only_consumable
#		If true, the no_consume gres are ignored.
#
# RETURN VALUE
#	A dict of GRES names and their count aggregating all types of
#	each GRES.
#
################################################################

proc count_gres {gres_param {only_consumable false}} {
	global gres_regex
	set gres_dict [dict create]
	foreach gres [split $gres_param ","] {
		if {[regexp $gres_regex $gres {} name type nc count] == 1} {
			if {$only_consumable && ($type eq "no_consume" || $nc eq "no_consume")} {
				continue
			} elseif {$nc eq ""} {
				set count $type
			} elseif {$count eq ""} {
				set count $nc
			}

			if {[dict exists $gres_dict $name]} {
				dict set gres_dict $name [expr [dict get $gres_dict $name] + $count]
			} else {
				dict set gres_dict $name $count
			}
		}
	}
	return $gres_dict
}

################################################################
#
# NAME
#	get_highest_gres_count - returns highest number of GRES per node on node_count nodes
#
# SYNOPSIS
#	get_highest_gres_count node_count gres_name
#
# DESCRIPTION
#	For a given number of nodes, returns the highest GRES count per
#	node available on at least that number of nodes.
#
# EXAMPLE
#	For example: node1 has 1 GPU, node2 has 2 GPUs and node3 has 3 GPUs
#	[get_highest_gres_count 1 "gpu"] returns 3 (i.e. 1 node 3 GPUs)
#	[get_highest_gres_count 2 "gpu"] returns 2 (i.e. 2 nodes have at least 2 GPUs each)
#	[get_highest_gres_count 3 "gpu"] returns 1 (i.e. 3 nodes have at least 1 GPU each)
#
################################################################

proc get_highest_gres_count { node_count gres_name } {

	set available_nodes [node_list_to_range [get_nodes_by_state]]
	set gres_dict [get_gres_count $gres_name $available_nodes]
	set gres_count [list]

	dict for {node gres} $gres_dict {
		lappend gres_count $gres
	}

	set count [lindex [lsort -decreasing -integer $gres_count] [expr $node_count - 1]]
	return $count
}


################################################################
#
# NAME
#	_set_gpu_socket_inx - adds a socket index to the gpu_sock_list if not already on it
#
# SYNOPSIS
#	_set_gpu_socket_inx sock_inx
#
# DESCRIPTION
#	Add a socket index to the array gpu_sock_list if not already
#	on the list. Subroutine used by get_gpu_socket_count
#
################################################################

proc _set_gpu_socket_inx { sock_inx } {
	global gpu_sock_list

	if {$sock_inx == -1} {
		set gpu_sock_list [lreplace $gpu_sock_list 0 99]
		return
	}

	set sock_cnt [llength $gpu_sock_list]
	for {set i 0} {$i < $sock_cnt} {incr i} {
		if {[lindex $gpu_sock_list $i] == $sock_inx} {
			return
		}
	}
	lappend gpu_sock_list $sock_inx
}


################################################################
# Subroutine used by get_gpu_socket_count
# Add a socket index to the array gpu_sock_list if not already
# on the list.
################################################################

proc _set_gpu_socket_range { sock_first_inx sock_last_inx } {
	global gpu_sock_list

	set sock_cnt [llength $gpu_sock_list]
	for {set s $sock_first_inx} {$s <= $sock_last_inx} {incr s} {
		set found 0
		for {set i 0} {$i < $sock_cnt} {incr i} {
			if {[lindex $gpu_sock_list $i] == $s} {
				set found 1
				break
			}
		}
		if {$found == 0} {
			lappend gpu_sock_list $s
		}
	}
}


################################################################
#
# NAME
#	get_gpu_socket_count - returns the number of sockets with GPUS on a node with the given per-node GPU count
#
# SYNOPSIS
#	get_gpu_socket_count gpu_cnt sockets_per_node
#
# DESCRIPTION
#	Given a per-node GPU count, return the number of sockets with
#	GPUs on a node with the given per-node GPU count.
#	If the sockets_per_node has a value of 1 then just return 1
#	rather than determine the count (for performance reasons).
#
################################################################

proc get_gpu_socket_count { gpu_cnt sockets_per_node } {
	global test_dir re_word_str bin_rm number scontrol srun gpu_sock_list

	set sockets_with_gpus 1
	set file_in "$test_dir/test_get_gpu_socket_count"

	if {$sockets_per_node == 1} {
		return 1
	}

	log_user 0
	_set_gpu_socket_inx -1
	make_bash_script $file_in "$scontrol show node \$SLURMD_NODENAME"
	spawn $srun -N1 --gres=gpu:$gpu_cnt $file_in
	expect {
		-re "gpu:${number}.S:($number)-($number)" {
			_set_gpu_socket_range $expect_out(1,string) $expect_out(2,string)
			exp_continue
		}
		-re "gpu:${re_word_str}:${number}.S:($number),($number),($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			_set_gpu_socket_inx $expect_out(3,string)
			_set_gpu_socket_inx $expect_out(4,string)
			exp_continue
		}
		-re "gpu:${re_word_str}:${number}.S:($number),($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			_set_gpu_socket_inx $expect_out(3,string)
			exp_continue
		}
		-re "gpu:${re_word_str}:${number}.S:($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			exp_continue
		}
		-re "gpu:${re_word_str}:${number}.S:($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			exp_continue
		}
		-re "gpu:${number}.S:($number),($number),($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			_set_gpu_socket_inx $expect_out(3,string)
			_set_gpu_socket_inx $expect_out(4,string)
			exp_continue
		}
		-re "gpu:${number}.S:($number),($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			_set_gpu_socket_inx $expect_out(3,string)
			exp_continue
		}
		-re "gpu:${number}.S:($number),($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			_set_gpu_socket_inx $expect_out(2,string)
			exp_continue
		}
		-re "gpu:${number}.S:($number)" {
			_set_gpu_socket_inx $expect_out(1,string)
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	set sock_cnt [llength $gpu_sock_list]
	if {$sock_cnt > 1} {
		set sockets_with_gpus $sock_cnt
	}

	return $sockets_with_gpus
}


################################################################
#
# NAME
#	get_highest_mps_count - get_highest_gres_count nodes mps, but for "mps per GPU"
#
# SYNOPSIS
#	get_highest_mps_count node_count
#
# DESCRIPTION
#	For a given number of nodes, returns the higest number of MPS per GPU
#	available at least on those number of nodes.
#
################################################################

proc get_highest_mps_count { node_count } {
	# We cannot use get_highest_gres_count because we need "per gpu",
	# so we get all the mps per node and all gpus per node, to create
	# a mps_per_gpu list to sort and get the count.
	set available_nodes [node_list_to_range [get_nodes_by_state]]
	set mps_dict [get_gres_count "mps" $available_nodes]
	set gpu_dict [get_gres_count "gpu" $available_nodes]
	set mps_per_gpu [list]

	dict for {node mps} $mps_dict {
		if { $mps > 0 } {
			if [dict exists $gpu_dict $node] {
				set gpu [dict get $gpu_dict $node]
				if { $gpu > 0 } {
					lappend mps_per_gpu [expr $mps / $gpu]
				} else {
					fail "All nodes with MPS should have a GPU"
				}
			} else {
				fail "All nodes with MPS should have a GPU"
			}
		}
	}

	set count [lindex [lsort -decreasing -integer $mps_per_gpu] [expr $node_count - 1]]
	return $count
}


################################################################
#
# NAME
#	get_mps_node_count - gets the number of nodes with a positive number of GRES MPS
#
# SYNOPSIS
#	get_mps_node_count
#
# RETURN VALUE
#	Return the count of nodes with a non-zero count of GRES MPS
#
################################################################

proc get_mps_node_count { } {
	global number sinfo re_word_str
	set fini 0
	set node_inx 0
	set def_part [default_partition]

	log_user 0
	spawn $sinfo -N -p$def_part -oGRES=%G -h
	expect {
		-re "GRES=($re_word_str)" {
			set mps_count 0
			set parts [split $expect_out(1,string) ",/"]
			while 1 {
				set mps_found [lsearch $parts "mps*"]
				if { $mps_found == -1 } break

				set parts2 [split [lindex $parts $mps_found] ":(/"]
				set col [lsearch -regexp $parts2 ^$number$]
				if { $col == -1 } {
					incr mps_count
				} else {
					set mps_count [expr $mps_count + [lindex $parts2 $col]]
				}
				set parts [lreplace $parts $mps_found $mps_found]
			}

			if {$mps_count > 0} {
				incr node_inx
			}
			exp_continue
		}
		eof {
			wait
		}
	}
	log_user 1

	return $node_inx
}


################################################################
#
# NAME
#	cuda_count - determines the count of allocated GPUs
#
# SYNOPSIS
#	cuda_count cuda_string
#
# ARGUMENTS
#	cuda_string
#		Contents of a CUDA_VISIBLE_DEVICES environment variable
#
# RETURN VALUE
#	Return the number of GPUs or -1 on error
#
################################################################

proc cuda_count { cuda_string } {
	set cuda_count 0
	set has_number 0
	set len [string length $cuda_string]
	for {set char_inx 0} {$char_inx < $len} {incr char_inx} {
		set cuda_char [string index $cuda_string $char_inx]
		if {[string match , $cuda_char]} {
			if {$has_number > 0} {
				incr cuda_count
				set has_number 0
			} else {
				log_error "Invalid input ($cuda_string)"
				return -1
			}
		} elseif {[string is digit $cuda_char]} {
			set has_number 1
		}
	}
	if {$has_number > 0} {
		incr cuda_count
	} else {
		log_error "Invalid input ($cuda_string)"
		return -1
	}
	return $cuda_count
}


################################################################
# NAME
#	get_conf_path - gets the path to the slurm.conf file
#
# SYNOPSIS
#	get_conf_path
#
# RETURN VALUE
#	Returns the path to the slurm.conf file
#
################################################################

proc get_conf_path { } {
	global scontrol re_word_str eol

	if [regexp {(.*)/slurm.conf} [get_config_param "SLURM_CONF"] {} config_dir] {
		return $config_dir
	} else {
		fail "Unable to determine config dir"
	}
}


################################################################
#
# NAME
#	save_conf - saves a backup of the specfied configuration file
#
# SYNOPSIS
#	save_conf file_name
#
# DESCRIPTION
#	If the specified file_name exists, a backup is made which will be
#	restored when restore_conf is called.
#	If the specified file_name does not exist, a special backup will be
#	made that will cause the file to be removed when restore_conf is
#	called.
#	If a backup already exists, a warning is issued and no backup is made
#	(honoring the existing backup).
#
# SEE ALSO
#	restore_conf
#
################################################################

proc save_conf { file_name } {
	global bin_chmod bin_cp bin_mv bin_touch test_name

	log_debug "Saving backup of $file_name"

	#
	# Check for existing backup
	# If a backup exists, issue a warning and return (honor existing backup)
	#
	set conf_dir [file dirname $file_name]
	set dir_files [glob -nocomplain -directory $conf_dir *]
	set preexisting_backup_file [lsearch -inline -regexp $dir_files "$file_name\\\.test\\d+\\\.\\d+\$"]
	if {$preexisting_backup_file ne ""} {
		log_warn "Backup file already exists: ($preexisting_backup_file)"
		return
	}

	#
	# Check if file to backup exists.
	# If it doesn't exist, warn the user, touch an empty backup file with
	# the sticky bit set and allow the test to continue.
	# restore_conf will remove the file.
	#
	set new_backup_file "$file_name.$test_name"
	if {![file exists $file_name]} {
		log_warn "Backup of a nonexistent file requested: $file_name"
		run_command -fail -nolog "$bin_touch $new_backup_file"
		run_command -fail -nolog "$bin_chmod +t $new_backup_file"
		return
	}

	run_command -fail -nolog "$bin_mv $file_name $new_backup_file"
	run_command -fail -nolog "$bin_cp $new_backup_file $file_name"
}


################################################################
#
# NAME
#	restore_conf - restores the original confiration file from backup
#
# SYNOPSIS
#	restore_conf file_name
#
# DESCRIPTION
#	If a backup exists for the specified file_name, it is restored.
#	If the specified file_name did not exist when originally backed up,
#	it will be removed.
#	If no backup exists, a warning is issued.
#
# SEE ALSO
#	save_conf
#
################################################################

proc restore_conf { file_name } {
	global bin_mv bin_rm

	log_debug "Restoring backup of $file_name"

	set conf_dir [file dirname $file_name]
	set dir_files [glob -nocomplain -directory $conf_dir *]
	set backup_file [lsearch -inline -regexp $dir_files "$file_name\\\.test\\d+\\\.\\d+\$"]
	if {$backup_file ne ""} {
		file stat $backup_file stat

		# If the sticky bit is set and the file is empty, remove both
		if {! $stat(size) && [expr $stat(mode) & 512]} {
			log_debug "Removing file used for the test: $file_name"
			run_command -fail -nolog "$bin_rm -f $backup_file $file_name"
		# Else replace the original with the backup
		} else {
			run_command -fail -nolog "$bin_mv $backup_file $file_name"
		}
	} else {
		#
		# If backup file doesn't exist, it has probably already been
		# restored by a previous call to restore_conf
		#
		log_warn "Backup file does not exist for $file_name. It has probably already been restored"
		return
	}
}


################################################################
#
# NAME
#	have_nvml - checks if HAVE_NVML is set in config.h
#
# SYNOPSIS
#	have_nvml
#
# RETURN VALUE
#	Returns true if HAVE_NVML is set in config.h. Else, returns false
#
################################################################

proc have_nvml { } {
	global bin_grep number config_h

	return [expr [run_command_status -none -nolog "$bin_grep \"HAVE_NVML 1\" $config_h"] == 0]
}


################################################################
#
# NAME
#	delete_part - deletes partition on system
#
# SYNOPSIS
#	delete_part partition
#
################################################################

proc delete_part { part_name } {
	global scontrol

	# Remove part
	spawn $scontrol delete partition=$part_name
	expect {
		timeout {
			fail "scontrol is not responding"
		}
		eof {
			wait
		}
	}
}


################################################################
#
# NAME
#	have_lua - checks if HAVE_LUA is set in config.h
#
# SYNOPSIS
#	have_lua
#
# RETURN VALUE
#	Returns true if HAVE_LUA is set in config.h. Else, returns false
#
################################################################

proc have_lua { } {
	global bin_grep config_h

	return [expr [run_command_status -none -nolog "$bin_grep HAVE_LUA $config_h"] == 0]
}


################################################################
#
# NAME
#	get_reservations - returns a dictionary of dictionaries of reservation parameters
#
# SYNOPSIS
#	get_reservations ?resv_name?
#
# RETURN VALUE
#	Uses `scontrol show reservation` to return a dictionary of dictionaries
#	of job parameters. Specifying an invalid resv_name result in a failure.
#
################################################################

proc get_reservations { {resv_name ""} } {
	global scontrol

	set command "$scontrol show reservation -o"
	if {$resv_name ne ""} {
		append command " $resv_name"
	}
	set output [run_command_output -fail "$command"]

	# Iterate over each reservation's parameter list
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }

		# Peel off the resv parameters one at a time
		# The first quantifier sets the greediness for the whole RE
		while {[regexp {^ *?([^ =]+)=(.*)(?= +[^ =]+=| *$)} $line {} param_name param_value]} {
			# Remove the consumed parameter from the line
			set line [regsub {^ *?[^ =]+=.*(?= +[^ =]+=| *$)} $line {}]
			# Add it to the temporary job dictionary
			dict set resv_dict $param_name $param_value
		}

		set resv_name_dict [dict get $resv_dict "ReservationName"]

		# Add the resv dictionary to resvs dictionary
		dict set resvs_dict $resv_name_dict $resv_dict

		# Clear the resv dictionary for the next resv
		set resv_dict {}
	}

	return $resvs_dict
}


################################################################
#
# NAME
#	get_reservation_param - returns a specific parameter value for a specific reservation
#
# SYNOPSIS
#	get_reservation_param resv_name parameter_name
#
# DESCRIPTION
#	Returns a specific parameter value for a specified reservation if the
#	parameter exists for the reservation, or MISSING if it does not exist.
#	Specifying an invalid reservation name will result in a failure.
#
################################################################

proc get_reservation_param { resv_name parameter_name } {

	set resvs_dict [get_reservations $resv_name]

	if [dict exists $resvs_dict $resv_name $parameter_name] {
		return [dict get $resvs_dict $resv_name $parameter_name]
	} else {
		return "MISSING"
	}
}


################################################################
#
# NAME
#	create_res - create new reservation in system
#
# SYNOPSIS
#	create_res ?res_name? ?res_params?
#
# RETURN VALUE
#	the exit code of the scontrol command run
#
################################################################

proc create_res { res_name res_params } {
	global scontrol

	set result   [run_command "$scontrol create res ReservationName=$res_name $res_params"]
	set output   [dict get $result output]
	set ret_code [dict get $result exit_code]

	if { $ret_code } {
		log_warn "[lindex [info level 0] 0]: error from scontrol: $output"
	} else {
		log_debug "[lindex [info level 0] 0]: success from scontrol: $output"
	}

	return $ret_code
}


################################################################
#
# NAME
#	update_res - update exisiting reservation in system
#
# SYNOPSIS
#	update_res ?res_name? ?res_params?
#
# RETURN VALUE
#	the exit code of the scontrol command run
#
################################################################

proc update_res { res_name res_params } {
	global scontrol

	set result   [run_command "$scontrol update ReservationName=$res_name $res_params"]
	set output   [dict get $result output]
	set ret_code [dict get $result exit_code]

	if { $ret_code } {
		log_warn "Return code from scontrol: $ret_code. Output: $output"
	}

	return $ret_code
}


################################################################
#
# NAME
#	delete_res - delete reservation from system
#
# SYNOPSIS
#	delete_res ?res_name?
#
# RETURN VALUE
#	the exit code of the scontrol command run
#
################################################################

proc delete_res { res_name } {
	global scontrol

	set result   [run_command "$scontrol delete ReservationName=$res_name"]
	set output   [dict get $result output]
	set ret_code [dict get $result exit_code]

	if { $ret_code } {
		log_warn "Return code from scontrol: $ret_code. Output: $output"
	}

	return $ret_code
}


################################################################
#
# NAME
#	create_part - creates a partition
#
# SYNOPSIS
#	create_part partition num_nodes
#
# ARGUMENTS
#	partition
#		Name of partition to create
#	num_nodes
#		Number of nodes of partition to create
#
# RETURN VALUE
#	RETURN_SUCCESS, or non-zero on error
#
################################################################

proc create_part { part_name num_nodes_in } {
	global scontrol srun bin_printenv number re_word_str

	set nodes ""
	set num_nodes_out 0

	set found 0
	spawn $scontrol show partitionname=$part_name
	expect {
		-re "PartitionName=$part_name" {
			set found 1
			exp_continue
		}
		timeout {
			fail "scontrol is not responding"
		}
		eof {
			wait
		}
	}

	if {$found == 1} {
		log_error "There is already a partition $part_name"
		return $::RETURN_ERROR
	}

	if {[string length [default_partition]] == 0} {
		log_warn "create_part does not work without a default partition"
		return $::RETURN_ERROR
	}

	if { $num_nodes_in } {
		set num_nodes $num_nodes_in
	} else {
		set num_nodes [llength [get_nodes_by_state]]
	}

	log_user 0
	# Get a list of nodes
	spawn $srun -t1 -N1-$num_nodes $bin_printenv
	expect {
		-re "SLURM_JOB_NUM_NODES=($number)" {
			set num_nodes_out $expect_out(1,string)
			exp_continue
		}
		-re "SLURM_NODELIST=($re_word_str)" {
			set nodes $expect_out(1,string)
			exp_continue
		}
		timeout {
			fail "srun is not responding getting number of nodes creating part"
		}
		eof {
			wait
		}
	}

	if {[string length $nodes] == 0} {
		log_error "Did not get a valid node list"
		return $::RETURN_ERROR
	} elseif { $num_nodes_out != $num_nodes_in } {
		log_error "Did not get enough nodes ($num_nodes_out != $num_nodes_in) to run test"
		return $::RETURN_ERROR
	}

	spawn $scontrol create partitionname=$part_name nodes=$nodes
	expect {
		timeout {
			fail "scontrol is not responding creating partition"
		}
		eof {
			wait
		}
	}

	set found 0
	spawn $scontrol show partitionname=$part_name
	expect {
		-re "PartitionName=$part_name" {
			set found 1
			exp_continue
		}
		timeout {
			fail "scontrol is not responding"
		}
		eof {
			wait
		}
	}

	if { $found == 0 } {
		log_error "scontrol did not create partition $part_name"
		return $::RETURN_ERROR
	}
	log_user 1

	log_debug "Created partition $part_name with $num_nodes_in nodes"
	return $::RETURN_SUCCESS
}


################################################################
#
# NAME
#	get_nodes - returns a dictionary of dictionaries of node parameters
#
# SYNOPSIS
#	get_nodes ?hostlist_expression?
#
# DESCRIPTION
#	Uses `scontrol show node` to query node parameters, returning a
#	dictionary of dictionaries with the node names as keys of the first
#	level dictionary and with the parameters as keys of the second level
#	dictionary. Specifying an invalid node name will result in a failure.
#
# RETURN VALUE
#	If the optional node expression argument is specified, the result will
#	be constrained by the specified hostlist expression. Otherwise, the
#	results for all nodes will be returned.
#
################################################################

proc get_nodes { {hostlist_expression ""} } {
	global scontrol

	set command "$scontrol show node -o"
	if {$hostlist_expression ne ""} {
		append command " $hostlist_expression"
	}
	set output [run_command_output -fail -nolog "$command"]

	# Iterate over each node parameter line
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }

		# Peel off the node parameters one at a time
		# The first quantifier sets the greediness for the whole RE
		while {[regexp {^ *?([^ =]+)=(.*)(?= +[^ =]+=| *$)} $line {} param_name param_value]} {
			# Remove the consumed parameter from the line
			set line [regsub {^ *?[^ =]+=.*(?= +[^ =]+=| *$)} $line {}]
			# Add it to the temporary node dictionary
			dict set node_dict $param_name $param_value
		}

		set node_name [dict get $node_dict "NodeName"]

		# Add the node dictionary to nodes dictionary
		dict set nodes_dict $node_name $node_dict

		# Clear the node dictionary for use by the next node
		set node_dict {}
	}

	return $nodes_dict
}


################################################################
#
# NAME
#	get_node_param - returns a specific parameter value for a specific node
#
# SYNOPSIS
#	get_node_param node_name parameter_name
#
# DESCRIPTION
#	Returns a specific parameter value for a specified node if the
#	parameter exists for the node, or MISSING if it does not exist.
#	Specifying an invalid node name will result in a failure.
#
################################################################

proc get_node_param { node_name parameter_name } {

	set nodes_dict [get_nodes $node_name]

	if [dict exists $nodes_dict $node_name $parameter_name] {
		return [dict get $nodes_dict $node_name $parameter_name]
	} else {
		return "MISSING"
	}
}


################################################################
#
# NAME
#	get_nodes_by_request - get a list of nodes satisfying requested resources
#
# SYNOPSIS
#	get_nodes_by_request ?options? ?request_args?
#
# DESCRIPTION
#	Using srun (optionally with the specified arguments), returns a list
#	of nodes having the requested resources.
#	If an error occurs, the invoking test will fail.
#
# OPTIONS
#	-fail
#		fail the test if the execution of srun results in an error or timeout
#
# ARGUMENTS
#	request_args
#		Desired resources of a node in form of srun arguments,
#		e.g. "--gres=gpu:1 -n1 -t1"
#
# RETURN VALUE
#	A list of nodes with at least the requested resources, or an empty
#	list otherwise.
#
################################################################

proc get_nodes_by_request args {
	global srun

	set options [list]
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fail {
				lappend options [lrange $args 0 0]
				set args [lrange $args 1 end]
			}
			default break
		}
	}

	if {[llength $args] == 1} {
		lassign $args request_args
	} elseif {[llength $args] == 0} {
		set request_args "-n1 -t1"
	} else {
		fail "[lindex [info level 0] 0]: Invalid number of arguments ([llength $args]): $args"
	}

	log_debug "Getting nodes that can be allocated with request: $request_args"
	set command "$srun -Q $request_args printenv SLURMD_NODENAME"
	set result [run_command {*}$options $command]

	if [dict get $result exit_code] {
		return {}
	}

	set output [dict get $result output]
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }
		dict incr allocated_nodes $line
	}

	return [lsort [dict keys $allocated_nodes]]
}


################################################################
#
# NAME
#	get_partitions - returns a dictionary of dictionaries of partition parameters
#
# SYNOPSIS
#	get_partitions ?partition_name?
#
# DESCRIPTION
#	Uses `scontrol show partitions` to query partition parameters,
#	returning a dictionary of dictionaries with the partition names
#	as keys of the first level dictionary and with the parameters as
#	keys of the second level dictionary. Specifying an invalid partition
#	name will result in a failure.
#
# RETURN VALUE
#	If the optional partition_name argument is specified, the result will
#	contain only the one patition. Otherwise, the results for all
#	partitions will be returned.
#
################################################################

proc get_partitions { {partition_name ""} } {
	global scontrol

	set command "$scontrol show partition -o"
	if {$partition_name ne ""} {
		append command " $partition_name"
	}
	set output [run_command_output -fail -nolog "$command"]

	# Iterate over each partition parameter line
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }

		# Peel off the partition parameters one at a time
		# The first quantifier sets the greediness for the whole RE
		while {[regexp {^ *?([^ =]+)=(.*)(?= +[^ =]+=| *$)} $line {} param_name param_value]} {
			# Remove the consumed parameter from the line
			set line [regsub {^ *?[^ =]+=.*(?= +[^ =]+=| *$)} $line {}]
			# Add it to the temporary node dictionary
			dict set part_dict $param_name $param_value
		}

		set part_name [dict get $part_dict "PartitionName"]

		# Add the node dictionary to nodes dictionary
		dict set parts_dict $part_name $part_dict

		# Clear the node dictionary for use by the next node
		set part_dict {}
	}

	return $parts_dict
}


################################################################
#
# NAME
#	get_partition_param - returns a specific parameter value for a specific partition
#
# SYNOPSIS
#	get_partition_param partitoin_name parameter_name
#
# DESCRIPTION
#	Returns a specific parameter value for a specified partition if the
#	parameter exists for the partition, or MISSING if it does not exist.
#	Specifying an invalid partition name will result in a failure.
#
################################################################

proc get_partition_param { partition_name parameter_name } {

	set partitions_dict [get_partitions $partition_name]

	if [dict exists $partitions_dict $partition_name $parameter_name] {
		return [dict get $partitions_dict $partition_name $parameter_name]
	} else {
		return "MISSING"
	}
}


################################################################
#
# NAME
#	get_jobs - returns a dictionary of dictionaries of job parameters
#
# SYNOPSIS
#	get_jobs ?job_id?
#
# DESCRIPTION
#	Uses `scontrol show job` to return a dictionary of dictionaries of job
#	parameters. Specifying an invalid job id will result in a failure.
#
################################################################

proc get_jobs { {job_id_in ""} } {
	global scontrol

	set command "$scontrol show job -d -o"
	if {$job_id_in ne ""} {
		append command " $job_id_in"
	}
	set output [run_command_output -fail "$command"]

	# Iterate over each job's parameter list
	foreach line [split $output "\n"] {
		if {$line eq ""} { continue }

		# Peel off the job parameters one at a time
		# The first quantifier sets the greediness for the whole RE
		while {[regexp {^ *?([^ =]+)=(.*)(?= +[^ =]+=| *$)} $line {} param_name param_value]} {
			# Remove the consumed parameter from the line
			set line [regsub {^ *?[^ =]+=.*(?= +[^ =]+=| *$)} $line {}]
			# Add it to the temporary job dictionary
			dict set job_dict $param_name $param_value
		}

		set job_id [dict get $job_dict "JobId"]

		# Add the job dictionary to jobs dictionary
		dict set jobs_dict $job_id $job_dict

		# Clear the job dictionary for the next job
		set job_dict {}
	}

	return $jobs_dict
}


################################################################
#
# NAME
#	get_job_param - returns a specific parameter value for a specific job
#
# SYNOPSIS
#	get_job_param job_id parameter_name
#
# DESCRIPTION
#	Returns a specific parameter value for a specified job if the
#	parameter exists for the job, or MISSING if it does not exist.
#	Specifying an invalid job id will result in a failure.
#
################################################################

proc get_job_param { job_id parameter_name } {

	set jobs_dict [get_jobs $job_id]

	if [dict exists $jobs_dict $job_id $parameter_name] {
		return [dict get $jobs_dict $job_id $parameter_name]
	} else {
		return "MISSING"
	}
}

proc check_reason { job_id reason } {
	global squeue

	set found 0
	spawn $squeue -j $job_id --noheader -o "%r"
	expect {
		-re "$reason" {
			set found 1
			exp_continue
		}
		timeout {
			log_error "squeue not responding"
		}
		eof {
			wait
		}
	}

	if {$found == 0} {
		log_error "Job $job_id should have a wait reason of $reason"
	}
	return $found
}


################################################################
#
# NAME
#	submit_job - submits a job with sbatch and returns its job id
#
# SYNOPSIS
#	submit_job ?options? job_args
#
# DESCRIPTION
#	Submits a job with sbatch and returns its jobid, or 0 if error.
#	It accepts all the options of run_command.
#
# OPTIONS
#	It accepts and passes all the options of/to run_command and also:
#	-env env
#		Prepend $env to the actual sbatch command to set environment
#		variables. For example "-env 'SLURM_NTASKS_PER_GPU=2'".
#
# ARGUMENTS
#	job_args
#		a string containing all the arguments to pass to sbatch
#
# RETURN VALUE
#	the job id, or 0 if an error happen
#
################################################################

proc submit_job args {
	global sbatch

	set env    ""
	set job_id 0

	set idx [lsearch $args -env]
	if {$idx >= 0} {
		set env  [lindex   $args [expr $idx+1]]
		set args [lreplace $args $idx [expr $idx+1]]
	}

	if {[llength $args] < 1} {
		fail "Wrong number of parameters, should be >=1"
	}
	set job_options [lindex $args [expr [llength $args] - 1 ]]
	set run_options   ""
	if {[llength $args] > 1} {
		set run_options [lrange $args 0 [expr [llength $args] - 2 ]]
	}

	set command ""
	if {$env ne ""} {
		set command "$env "
	}
	set command "$command$sbatch $job_options"
	set output [run_command_output {*}$run_options "$command"]
	regexp {Submitted \S+ job (\d+)} $output - job_id

	return $job_id
}

###############################################################################
#
# NAME
#	check_exclusive_gres - Given a job_id and node_name of an exclusive
#                              allocation make sure we allocated all GRES.
#
################################################################################

proc check_exclusive_gres { job_id node_name } {
	# Check all consumable GRES of the node were allocated on the job
	set gres_dict_job  [count_gres [get_job_param  $job_id "JOB_GRES"]]
	set gres_dict_node [count_gres [get_node_param $node_name "Gres"] true]

	dict for {gres_name gres_count} $gres_dict_node {
		# We don't want mps to be allocated with --exclusive
		if {$gres_name eq "mps" || $gres_name eq "shard"} {
			if {[dict exists $gres_dict_job $gres_name]} {
				subfail "Gres ($gres_name) on node ($node_name) allocated on job ($job_id) with --exclusive but it shouldn't be"
			} else {
				subpass "Gres ($gres_name) on node ($node_name) was not allocated on job ($job_id) with --exclusive, this is expected"
			}
		} elseif {![dict exists $gres_dict_job $gres_name]} {
			subfail "Gres ($gres_name) on node ($node_name) not allocated on job ($job_id) with --exclusive"
		} else {
			subpass "Gres ($gres_name) on node ($node_name) was allocated on job ($job_id) with --exclusive"

			set gres_count_job [dict get $gres_dict_job $gres_name]
			subtest { $gres_count_job == $gres_count } "Gres ($gres_name) on node ($node_name) fully allocated on job ($job_id) with --exclusive" "$gres_count_job != $gres_count"
		}
	}
}

################################################################
#
# NAME
#	compile_against_libslurm - compiles a test program against either libslurm.so or libslurmfull.so
#
# SYNOPSIS
#	compile_against_libslurm ?options? test_prog ?build_args?
#
# DESCRIPTION
#	Compile a test program against either libslurm.so or libslurmfull.so.
#
# OPTIONS
#	-full
#		use libslurmfull.so instead of libslurm.so
#	-shared
#		produces a shared library (adds the -shared compiler option
#		and adds a .so suffix to the output file name)
#
# ARGUMENTS
#	test_prog
#		The name of the test program (and .c file)
#	build_args
#		Additional string to be appended to the build command.
#		E.g. "-DUSING_VALGRIND -lm ${build_dir}/src/slurmctld/locks.o"
#		(initial space will be added automatically).
#
################################################################################

proc compile_against_libslurm args {
	global slurm_dir bin_cc src_dir build_dir bin_chmod

	set use_full   false
	set shared     false
	set build_args ""
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-full    {set use_full true; set args [lrange $args 1 end]}
			-shared  {set shared true; set args [lrange $args 1 end]}
			-*       {fail "Unknown option: [lindex $args 0]"}
			default  break
		}
	}
	set argument_count [llength $args]
	if {$argument_count < 1} {
		fail "Too few arguments ($argument_count): $args"
	} else {
		lassign $args test_prog
	}
	if {$argument_count == 2} { set build_args [lindex $args 1] }
	if {$argument_count > 2} {
		fail "Too many arguments ($argument_count): $args"
	}

	if {$use_full} {
		set libfile "libslurmfull.so"
	} else {
		set libfile "libslurm.so"
	}

	if [file exists $slurm_dir/lib64/slurm/$libfile] {
		set libdir "lib64"
	} else {
		set libdir "lib"
	}

	if {$use_full} {
		set libline "$slurm_dir/$libdir/slurm"
		set libfile "slurmfull"
	} else {
		set libline "$slurm_dir/$libdir"
		set libfile "slurm"
	}

	set build_cmd "$bin_cc ${test_prog}.c -g -pthread"

	if {$shared} {
		set out "${test_prog}.so"
		append build_cmd " -fPIC -shared"
	} else {
		set out "${test_prog}"
	}
	append build_cmd " -o $out"

	append build_cmd " -I$src_dir -I$build_dir -I$slurm_dir/include -Wl,-rpath=$libline -L$libline -l$libfile -lresolv"

	# Add additional arguments to the build command
	if {$build_args != ""} {
		append build_cmd " $build_args"
	}

	log_debug "Build command: $build_cmd"
	catch {exec {*}$build_cmd} out_str out_dict
	if {[dict get $out_dict -code]} {
		log_error $out_str
		return $::RETURN_ERROR
	}

	exec $bin_chmod 700 $out
	return $::RETURN_SUCCESS
}


################################################################
#
# NAME
#	subtest - tests a boolean condition and updates subtest tallies
#
# SYNOPSIS
#	subtest ?options? condition description ?diagnostics?
#
# DESCRIPTION
#	Based on the results of testing a boolean expression, increments the
#	relevant subtest count (pass, fail or skip) and logs a message.
#
# OPTIONS
#	-fatal
#		If the subtest fails, causes a fatal error ending the test
#
# ARGUMENTS
#	condition
#		The boolean expression to test
#	description
#		A single-line string describing what is being tested. This is
#		a subtest "name" that is displayed with the log message
#		whether the subtest passes or fails
#	diagnostics
#		A string providing additional diagnostic information that is
#		only included in the log message on failure
#
# RETURN VALUE
#	the boolean condition evaluated
#
# ENVIRONMENT
#	testsuite_subtest_fatal
#		Specifies whether first failing subtest aborts the test
#
################################################################

proc subtest args {

	set options [list]
	while {[llength $args]} {
		switch -glob -- [lindex $args 0] {
			-fatal -
			-fail  {
				lappend options -fatal
				set args [lrange $args 1 end]
			}
			-*      {fail "Unknown option: [lindex $args 0]"}
			default break
		}
	}
	set argument_count [llength $args]
	if {$argument_count < 2} {
		fail "Too few arguments ($argument_count): $args"
	} else {
		set args [lassign $args condition description]
	}

	if [uplevel 1 expr [format "{%s}" $condition]] {
		subpass $description
		return true
	} else {
		subfail {*}$options $description {*}$args
		return false
	}
}


################################################################
#
# NAME
#	_is_testproc_included - returns if testproc_id was included or not excluded in argv
#
# SYNOPSIS
#	_is_testproc_included testproc_id testproc_alias
#
# DESCRIPTION
#	From command line the test runner can use -i and -e to include or
#	exclude some test functions by their number. This function must be
#	used to check if the test runner included or excluded the given
#	testproc_id.
#
# RETURN VALUE
#	true is testproc_id or testproc_alias was included with -i or not
#	excluded -e, false otherwise
#
################################################################

proc _is_testproc_included {testproc_id testproc_alias} {
	global _testproc_included _testproc_excluded

	if {[llength $_testproc_included]} {
		if {[lsearch $_testproc_included $testproc_id] >= 0 || \
		    [lsearch $_testproc_included $testproc_alias] >= 0} {
			return true
		}
		return false
	}

	if {[llength $_testproc_excluded]} {
		if {[lsearch $_testproc_excluded $testproc_id] >= 0 || \
		    [lsearch $_testproc_excluded $testproc_alias] >= 0} {
			return false
		}
	}

	return true
}


################################################################
#
# NAME
#	skip_following_testprocs - the following testproc calls will be skipped
#
# SYNOPSIS
#	skip_following_testprocs reason
#
# ARGUMENTS
#	reason
#		The string with the reason message to add on the skip message
#		on each skipped testproc.
#
# DESCRIPTION
#	This function disables normal execution of testproc calls.
#	It is meant to be used when some testprocs cannot be run due config
#	limitations, but still call testproc to register what testprocs
#	are skipped for a given reason.
#	Use run_following_testprocs to reenable the norma execution of testprocs.

################################################################

proc skip_following_testprocs {reason} {
	global _testproc_skip_next _testproc_skip_reason

	set _testproc_skip_next   true
	set _testproc_skip_reason $reason
}


################################################################
#
# NAME
#	run_following_testprocs - the following testproc call will be run (if not excluded from command line)
#
# SYNOPSIS
#	run_following_testprocs
#
# DESCRIPTION
#	This function reenables the normal execution of testproc calls.
#	It is meant to be used when skip_following_testprocs was called to skip
#	previous testproc calls, and we want to normally run the following ones.
#	Note that it does NOT overwrite what -i and -e included are passed
#	from command line.
#
################################################################

proc run_following_testprocs {} {
	global _testproc_skip_next _testproc_skip_reason

	set _testproc_skip_next   false
	set _testproc_skip_reason ""
}


################################################################
#
# NAME
#	testproc - launcher to run or skip a testproc_call
#
# SYNOPSIS
#	testproc testproc_call
#
# ARGUMENTS
#	A testproc_call is any normal call to a proc with any arguments that
#	could be done normally without the testproc launcher.
#	For example, we could normally do:
#
#	test_my_feature $some_args $expected_out
#
#	Or use the launcher like:
#
#	testproc test_my_feature $some_args $expected_out
#
# DESCRIPTION
#	Using the testproc launcher has the following main benefits:
#	a) Handles the -i and -e terminal options to include or exclude some
#	   testprocs numbers.
#	b) Runs or skips based on the last call of testproc_{skip,run}_following.
#	c) Creates extra sections in the status summary
#	   (see testsuite_testproc_details).
#
# RETURN VALUE
#	The rc of the testproc_call if it has been run, or $::RETURN_SUCCESS
#	otherwise. Using it is not recommended, though.
#
################################################################

proc testproc args {
	return [testproc_alias "" {*}$args]
}


################################################################
#
# NAME
#	testproc_alias - launcher to run or skip a testproc_call, with an alias
#
# SYNOPSIS
#	testproc alias testproc_call
#
# DESCRIPTION
#	See testproc
#
################################################################

proc testproc_alias {alias args} {
	global _testproc_pass_list _testproc_skip_list _testproc_fail_list
	global _testproc_skip_next _testproc_skip_reason
	global _testproc_messages testsuite_testproc_log_calls
	global _subtest_pass_count
	global _subtest_skip_count
	global _subtest_fail_count

	# Avoid integer alias to avoid confusions with testproc_id
	if {[llength $alias] && [string is integer -strict $alias]} {
		fail "testproc_alias doesn't support integer alias, use alphanumeric"
	}

	# Save previous subtest counts and next subtest num
	set prev_pass $_subtest_pass_count
	set prev_skip $_subtest_skip_count
	set prev_fail $_subtest_fail_count
	set prev_subtest [expr $_subtest_pass_count + \
	                       $_subtest_skip_count + \
	                       $_subtest_fail_count + 1]

	# Get the testproc number
	set testproc_id [expr [llength $_testproc_pass_list] + \
	                      [llength $_testproc_skip_list] + \
	                      [llength $_testproc_fail_list] + 1]

	# Run or skip the testproc
	set rc $::RETURN_SUCCESS
	set reason ""
	if {![_is_testproc_included $testproc_id $alias]} {
		set reason "(Excluded from command line)"
		if {$testsuite_testproc_log_calls == yes} {
			subskip -nolog "Skipping testproc $testproc_id: {$args} $reason"
		} else {
			subskip -nolog "Skipping testproc $testproc_id: $reason"
		}
	} else {
		if {$_testproc_skip_next} {
			set reason "($_testproc_skip_reason)"
			if {$testsuite_testproc_log_calls == yes} {
				subskip  "Skipping testproc $testproc_id: {$args} $reason"
			} else {
				subskip  "Skipping testproc $testproc_id: $reason"
			}
		} else {
			if {$testsuite_testproc_log_calls != no} {
				log_info "Running testproc $testproc_id: $args"
			} else {
				log_info "Running testproc $testproc_id"
			}
			set rc [{*}$args]
		}
	}

	# Get current subtest counts
	set curr_subtest [expr $_subtest_pass_count + \
	                       $_subtest_skip_count + \
	                       $_subtest_fail_count]

	# Register the testproc as fail, skip or pass (based on subtests)
	if {[llength $alias]} {
		set alias "${alias}: "
	}
	if {$_subtest_fail_count > $prev_fail} {
		set reason "(Subtests: $prev_subtest to $curr_subtest)"
		lappend  _testproc_fail_list $testproc_id
		if {$testsuite_testproc_log_calls != no} {
			dict set _testproc_messages  $testproc_id [list failed "$alias{$args} $reason"]
		} else {
			dict set _testproc_messages  $testproc_id [list failed "$alias$reason"]
		}
	} elseif {$_subtest_skip_count > $prev_skip} {
		lappend  _testproc_skip_list $testproc_id
		if {$testsuite_testproc_log_calls == yes} {
			dict set _testproc_messages  $testproc_id [list skipped "$alias{$args} $reason"]
		} else {
			dict set _testproc_messages  $testproc_id [list skipped "$alias$reason"]
		}
	} else {
		set reason "(Subtests: $prev_subtest to $curr_subtest)"
		lappend  _testproc_pass_list $testproc_id
		if {$testsuite_testproc_log_calls == yes} {
			dict set _testproc_messages  $testproc_id [list passed "$alias{$args} $reason"]
		} else {
			dict set _testproc_messages  $testproc_id [list passed "$alias$reason"]
		}
	}

	return $rc
}


################################################################
#
# NAME
#	_log_format - prints a log message with colorization and formatting
#
# SYNOPSIS
#	_log_format log_level message
#
# DESCRIPTION
#	This procedure is called by the log_<level> procedures and
#	derives the relevant log level from the caller's procedure name.
#
# ARGUMENTS
#	log_level
#		The logging threshold that triggered the log statement
#	message
#		The message to print with colorization and formatting
#
# ENVIRONMENT
#	testsuite_log_format
#		Used as the template for the fields to be output.
#		Fields must be expressed in the form:
#			%{<field_name>}<format_conversion_specifier>
#		Supported fields include the following:
#			message
#				The log message
#			filename
#				The file name where the log_<log_level>
#				procedure was called from
#			lineno
#				The line number where the log_<log_level>
#				procedure was called from
#			timestamp
#				The date and time when the log_<log_level>
#				procedure was called at
#			msecs
#				The milliseconds when the log_<log_level>
#				procedure was called at
#			loglevel
#				The log level that triggers the log_<log_level>
#				procedure to be called
#			backtrace
#				An abbreviated call stack trace with line
#				numbers
#	testsuite_time_format
#		Used as a template for the timestamp. See the format groups
#		for the tcl clock format command.
#	testsuite_colorize
#		Boolean that turns colorization on or off
#	testsuite_color_<log_level>
#		Can be set to define the color used for each log level
#
################################################################

proc _log_format { log_level message } {
	global testsuite_colorize testsuite_log_format testsuite_time_format
	global COLOR_NONE
	global testsuite_color_fatal testsuite_color_error testsuite_color_warn
	global testsuite_color_info testsuite_color_pass testsuite_color_command
	global testsuite_color_debug testsuite_color_trace

	set format_string $testsuite_log_format
	set milliseconds_since_epoch [clock milliseconds]
	set date_time [clock format [expr {$milliseconds_since_epoch / 1000}] -format "$testsuite_time_format"]
	set milliseconds [expr {$milliseconds_since_epoch % 1000}]

	set frame_level -2
	while { [dict get [info frame $frame_level] type] != "source" } {
		incr frame_level -1
	}

	set format_args {}
	while {[regexp "%{\[a-z]+}" $format_string format_field]} {
		if {$format_field eq "%{message}"} {
			lappend format_args $message
		} elseif {$format_field eq "%{filename}"} {
			lappend format_args [file tail [dict get [info frame $frame_level] file]]
		} elseif {$format_field eq "%{lineno}"} {
			lappend format_args [dict get [info frame $frame_level] line]
		} elseif {$format_field eq "%{timestamp}"} {
			lappend format_args $date_time
		} elseif {$format_field eq "%{msecs}" || $format_field eq "%{milliseconds}"} {
			lappend format_args $milliseconds
		} elseif {$format_field eq "%{loglevel}" || $format_field eq "%{levelname}"} {
			lappend format_args [string totitle $log_level]
		} elseif {$format_field eq "%{backtrace}"} {
			lappend format_args [_line_trace]
		} else {
			fail "Invalid field ($format_field) specified in testsuite_log_format"
		}
		regsub $format_field $format_string "%" format_string
	}

	if ($testsuite_colorize) {
		switch $log_level {
			fatal   { append output $testsuite_color_fatal }
			error   { append output $testsuite_color_error }
			warning { append output $testsuite_color_warn }
			info    { append output $testsuite_color_info }
			pass    { append output $testsuite_color_pass }
			command { append output $testsuite_color_command }
			debug   { append output $testsuite_color_debug }
			trace   { append output $testsuite_color_trace }
		}
	}
	append output [format $format_string {*}$format_args]
	if ($testsuite_colorize) {
		append output $COLOR_NONE
	}
	puts $output
}


################################################################
#
# NAME
#	_print_header - prints a test header
#
# SYNOPSIS
#	_print_header
#
# ENVIRONMENT
#	testsuite_colorize
#		Boolean that turns colorization on or off
#	testsuite_color_header
#		Can be set to define the color used for the header
#
################################################################

proc _print_header { } {
	global test_name testsuite_color_header testsuite_colorize COLOR_NONE

	if ($testsuite_colorize) {
		append output $testsuite_color_header
	}
	append output [string repeat = 78]\n
	append output [format "%-9s" "TEST:"]${test_name}\n
	append output [string repeat = 78]
	if ($testsuite_colorize) {
		append output $COLOR_NONE
	}
	puts $output
}


################################################################
#
# NAME
#	_print_summary - prints the final status summary
#
# SYNOPSIS
#	_print_summary status completed
#
# ARGUMENTS
#	status
#		The final status of the test.
#		When status is zero, we print SUCCESS.
#		When status is negative, we print SKIPPED.
#		When status is positive, we print FAILURE.
#
#	completed
#		A boolean value that is true if the test completed and false
#		if aborted (ended early with exit status != 0)
#
# ENVIRONMENT
#	testsuite_colorize
#		Boolean that turns colorization on or off
#	testsuite_color_<test_status>
#		Can be set to define the color used for each test status
#
################################################################

proc _print_summary {status completed} {
	global test_name testsuite_colorize COLOR_NONE
	global testsuite_color_success testsuite_color_skipped
	global testsuite_color_failure
	global _subtest_fail_count _subtest_pass_count _subtest_skip_count
	global _testproc_pass_list _testproc_skip_list _testproc_fail_list
	global _incomplete_reason
	global _subtest_messages _testproc_messages
	global testsuite_subtest_details testsuite_testproc_details

	if {$status == 0} {
		set color $testsuite_color_success
		set header "SUCCESS"
	} elseif {$status < 0} {
		set color $testsuite_color_skipped
		set header "SKIPPED"
	} elseif {$status > 0} {
		set color $testsuite_color_failure;
		set header "FAILURE"
	}

	if ($testsuite_colorize) {
		append output $color
	}

	append output [string repeat = 78]\n

	# Get subtest and testproc counts
	set testproc_fail  [llength $_testproc_fail_list]
	set testproc_skip  [llength $_testproc_skip_list]
	set testproc_pass  [llength $_testproc_pass_list]
	set testproc_count [expr $testproc_pass + \
	                         $testproc_skip + \
	                         $testproc_fail]
	set subtest_count  [expr $_subtest_fail_count + \
	                         $_subtest_pass_count + \
	                         $_subtest_skip_count]

	# Initial summary
	append output [format "%s             : %s\n" $header  $test_name]
	if {$testproc_count > 0} {
		append output [format "  Testprocs failed  : %3d (%3d%%)%s\n" $testproc_fail [expr $testproc_fail * 100 / $testproc_count] \
		                                                             [expr {$testproc_fail ? " List: [join $_testproc_fail_list ,]" : ""}]]
		append output [format "  Testprocs skipped : %3d (%3d%%)%s\n" $testproc_skip [expr $testproc_skip * 100 / $testproc_count] \
		                                                             [expr {$testproc_skip ? " List: [join $_testproc_skip_list ,]" : ""}]]
		append output [format "  Testprocs passed  : %3d (%3d%%)\n"   $testproc_pass [expr $testproc_pass * 100 / $testproc_count]]
		append output [format "  Testprocs total   : %3d %s\n"        $testproc_count [expr {$completed ? "COMPLETE" : "INCOMPLETE: $_incomplete_reason"}]]
	}
	if {$subtest_count > 0} {
		if {$testproc_count > 0} {
			append output \n
		}
		append output [format "  Subtests failed   : %3d (%3d%%)\n" $_subtest_fail_count [expr $_subtest_fail_count * 100 / $subtest_count]]
		append output [format "  Subtests skipped  : %3d (%3d%%)\n" $_subtest_skip_count [expr $_subtest_skip_count * 100 / $subtest_count]]
		append output [format "  Subtests passed   : %3d (%3d%%)\n" $_subtest_pass_count [expr $_subtest_pass_count * 100 / $subtest_count]]
		append output [format "  Subtests total    : %3d %s\n"      $subtest_count [expr {$completed ? "COMPLETE" : "INCOMPLETE: $_incomplete_reason"}]]
	}
	append output [string repeat = 78]\n

	# Detailed information
	if {$testsuite_subtest_details ne "none"} {
		set show_details false
		if {$testsuite_subtest_details eq "all" && $subtest_count > 0} {
			set show_details true
		} elseif {$testsuite_subtest_details eq "fail_skip" && $_subtest_skip_count > 0} {
			set show_details true
		} elseif {$_subtest_fail_count > 0} {
			set show_details true
		}

		if {$show_details} {
			append output [format "SUBTESTS DETAILS     : %s\n" $test_name]
			dict for {id result_msg} $_subtest_messages {
				set result [lindex $result_msg 0]
				if {$testsuite_subtest_details eq "all"} {
					append output [format "  %s\n" [lindex $result_msg 1]]
				} elseif {$testsuite_subtest_details eq "fail_skip" && $result eq "skip"} {
					append output [format "  %s\n" [lindex $result_msg 1]]
				} elseif {$result eq "fail"} {
					append output [format "  %s\n" [lindex $result_msg 1]]
				}
			}
			append output [string repeat = 78]\n
		}
	}
	if {$testsuite_testproc_details ne "none"} {
		set show_details false
		if {$testsuite_testproc_details eq "all" && $testproc_count > 0} {
			set show_details true
		} elseif {$testsuite_testproc_details eq "fail_skip" && $testproc_skip > 0} {
			set show_details true
		} elseif {$testproc_fail > 0} {
			set show_details true
		}

		if {$show_details} {
			append output [format "TESTPROCS DETAILS     : %s\n" $test_name]
			dict for {num result_msg} $_testproc_messages {
				set result [lindex $result_msg 0]
				if {$testsuite_testproc_details eq "all"} {
					append output [format "  Testproc %2d %-7s : %s\n" $num [lindex $result_msg 0] [lindex $result_msg 1]]
				} elseif {$testsuite_testproc_details eq "fail_skip" && $result eq "skipped"} {
					append output [format "  Testproc %2d %-7s : %s\n" $num [lindex $result_msg 0] [lindex $result_msg 1]]
				} elseif {$result eq "failed"} {
					append output [format "  Testproc %2d %-7s : %s\n" $num [lindex $result_msg 0] [lindex $result_msg 1]]
				}
			}
			append output [string repeat = 78]\n
		}
	}

	if ($testsuite_colorize) {
		append output $COLOR_NONE
	}

	puts -nonewline $output
}


################################################################
#
# NAME
#	_get_test_name - gets the name of the invoking source script
#
# SYNOPSIS
#	_get_test_name
#
# RETURN VALUE
#	The name of the originally called script
#
################################################################

proc _get_test_name { } {

	set test_name unknown
	set frame_level 1
	while { $frame_level <= [info frame] } {
		if { [dict get [info frame $frame_level] type] == "source" } {
			set test_name [file tail [dict get [info frame $frame_level] file]]
			break
		}
		incr frame_level
	}

	return $test_name
}


################################################################
#
# NAME
#	_test_cleanup - performs the test cleanup
#
# SYNOPSIS
#	_test_cleanup
#
# DESCRIPTION
#	This procedure removes the temporary test_dir and calls the
#	test-defined cleanup procedure.
#
# NOTES
#	This function should be called only from _test_init and _test_fini.
#
################################################################

proc _test_cleanup {} {
	global log_warn test_dir

	set rc 0

	# Call global cleanup procedure if it is defined by the test
	if {[info procs cleanup] eq "cleanup"} {
		if {[catch {cleanup} cleanup_error ]} {
			log_error "Cleanup had errors: $cleanup_error"
			set rc 1
		}
	 }

	# Remove the temporary test directory
	exec rm -rf $test_dir

	return $rc
}


################################################################
#
# NAME
#	_test_init - performs test initialization
#
# SYNOPSIS
#	_test_init
#
# DESCRIPTION
#	This procedure is called automatically at the beginning of each test.
#	It prints the header, creates the temporary test dir, etc.
#
################################################################

proc _test_init {} {
	global test_dir test_id test_name testsuite_shared_dir
	global _testproc_included _testproc_excluded argv bin_chmod scontrol

	# parse argv to get and remove _testproc_included and _testproc_excluded params
	set idx [expr {[info exists argv] ? [lsearch $argv -i] : -1}]
	if {$idx >= 0} {
		set _testproc_included [split [lindex $argv [expr $idx + 1]] ,]
		set argv [lreplace $argv $idx [expr $idx + 1]]
	}
	set idx [expr {[info exists argv] ? [lsearch $argv -e] : -1}]
	if {$idx >= 0} {
		set _testproc_excluded [split [lindex $argv [expr $idx + 1]] ,]
		set argv [lreplace $argv $idx [expr $idx + 1]]
	}

	# Set test name to name of originally invoked test script, e.g. test1.1
	set test_name [_get_test_name]

	# Set test id to suffix of the test script, e.g. 1.1
	set test_id [string map {test ""} $test_name]

	# Temporary test directory used to stash saved configs, output files...
	set test_dir  "$testsuite_shared_dir/${test_name}dir"

	# Print test header
	_print_header

	# Cleanup in case test was not cleaned up on last execution
	if { [_test_cleanup] } {
		fail "Error in the initial cleanup"
	}

	# Create temporary shared test directory
	exec mkdir -p $test_dir
	exec $bin_chmod a+rwx $test_dir

	# Default precondition checks
	if {![regexp "is UP" [run_command_output -nolog -none "$scontrol ping"]]} {
		skip "The expect testsuite requires Slurm to be running, but '$scontrol ping' failed."
	}
	set idle_nodes [get_nodes_by_state]
	if {[llength $idle_nodes] < 1} {
		skip "The expect testsuite requires there to be at least one idle node in the default partition."
	}
	# Ensure that idle nodes are not drained/down
	# Checking one by one to be able to print a warning if some was drain/down
	foreach idle_node $idle_nodes {
		run_command -nolog -xfail "$scontrol update nodename=$idle_node state=resume"
	}
}


################################################################
#
# NAME
#	_test_fini - performs test finalization
#
# SYNOPSIS
#	_test_fini ?status?
#
# DESCRIPTION
#	This procedure is called automatically from the ending functions
#	pass, skip and failure.
#	It cleans up based on the status and the testsuite_cleanup_on_failure
#	variable, prints the final test status/summary, and exits the test.
#
#	We will always cleanup for SUCCESS or SKIPPED tests.
#	Whether or not the cleanup procedure is called for FAILURE tests
#	depends on the setting of the $testsuite_cleanup_on_failure variable
#	which can be set in the globals.local file or overridden with the
#	SLURM_TESTSUITE_CLEANUP_ON_FAILURE environment variable.
#
################################################################

proc _test_fini { status } {
	global testsuite_cleanup_on_failure _test_fini_called
	global _subtest_fail_count _subtest_skip_count
	global STATUS_FAIL STATUS_PASS STATUS_SKIP test_status

	# Avoid potential infinite recursive calls.
	# _test_fini should be called only once, but custom cleanup procs
	# called from _test_cleanup can potentially call it (eg fail)
	if {$_test_fini_called} {
		log_debug "Recursive _test_fini call detected, most probably a fail on a cleanup function"
		return
	}
	set _test_fini_called true


	# Determine if test completed or was aborted
	set completed [expr $status == $STATUS_PASS ? true : false]

	# Override status with subtest status if available and necessary
	if {$status != $STATUS_FAIL} {
		if {$_subtest_fail_count > 0} {
			set status $STATUS_FAIL
		} elseif {$_subtest_skip_count > 0} {
			set status $STATUS_SKIP
		}
	}

	# Set final test status global variable so it can be used in cleanup
	set test_status $status

	# Only cleanup if test not failed or configured to do so
	if {$status != $STATUS_FAIL || $testsuite_cleanup_on_failure} {
		_test_cleanup
	}
	_print_summary $status $completed

	__exit $status
}


################################################################
#
# Overload the exit routine to ensure that no one is explicitly
# calling it, and to enforce _test_fini if exit is called when
# the test reach its EOF.
#
# All tests should exit using pass, skip or fail.
#
################################################################

rename exit __exit

proc exit { {status 0} } {
	global test_name

	# To avoid failures when using "expect -c 'source globals'"
	if {$test_name eq "globals"} {
		pass
	}

	#
	# Minor sanity check to detect if exit was explicitly called (not
	# allowed) or automatically executed when the test ends
	#
	if {[info level] > 1} {
		# exit was called from a function, and it shouldn't
		fail "Exit should not be directly called, use pass, skip or fail instead"
	} else {
		set frame_level 1
		while { $frame_level <= [info frame] } {
			if { [dict get [info frame $frame_level] type] == "source" } {
				if { [file tail [dict get [info frame $frame_level] file]] eq $test_name } {
					# exit was called explicitly from the
					# test, and it shouldn't
					fail "Exit should not be directly called, use pass, skip or fail instead"
				}
				break
			}
			incr frame_level
		}
	}

	if {$status != 0} {
		fail "An Expect/TCL exception occurred"
	}

	# The exit was called implicitly when the test ends, allowed but
	# _test_fini call enforced
	pass
}


# Call _test_init at the beginning of each test
_test_init