##############################################################################
#   Modules Revision 3.0
#   Providing a flexible user environment
#
#   File:		config/%M%
#   Revision:		%I%
#   First Edition:	2020/12/05
#   Last Mod.:		%U%, %G%
#
#   Authors:		Xavier Delaruelle, xavier.delaruelle@cea.fr
#
#   Description:	Testuite initialization
#   Command:
#   Sub-Command:
#
#   Comment:	%C{
#			Initialization of the testsuite. Definition of
#			globally used start procedures for the test
#			target.
#		}C%
#
##############################################################################

#
# Shell conversion code subprocedures
#

proc shell_err {test_shell {nb_err 1} {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
        set nb "\\d"
    } else {
        set esc ""
        set nb $nb_err
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
           set answer "test 0 = 1;"
        }
        {tcl} {
            set answer "set _mlstatus 0;"
        }
        {cmd} {
            set answer "set errorlevel=1"
        }
        {perl} {
            set answer "{ no strict 'vars'; ${esc}\$_mlstatus = 0; }"
        }
        {python} {
            set answer "_mlstatus = False"
        }
        {ruby} {
            set answer "_mlstatus = false"
        }
        {lisp} {
            set answer "nil"
        }
        {cmake} {
            set answer "set${esc}(_mlstatus FALSE${esc})"
        }
        {r} {
            set answer "mlstatus <- FALSE"
        }
        {pwsh} {
            set answer "Set-Variable -Name \"_mlstatus\" -Value ${esc}\$false -Scope Global"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_ok {test_shell {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
            set answer "test 0;"
        }
        {tcl} {
            set answer "set _mlstatus 1;"
        }
        {cmd} {
            set answer "set errorlevel=0"
        }
        {python} {
            set answer "_mlstatus = True"
        }
        {ruby} {
            set answer "_mlstatus = true"
        }
        {perl} {
            set answer "{ no strict 'vars'; ${esc}\$_mlstatus = 1; }"
        }
        {lisp} {
            set answer "t"
        }
        {cmake} {
            set answer "set${esc}(_mlstatus TRUE${esc})"
        }
        {r} {
            set answer "mlstatus <- TRUE"
        }
        {pwsh} {
            set answer "Set-Variable -Name \"_mlstatus\" -Value ${esc}\$true -Scope Global"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_text {test_shell val {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
            foreach word $val {
                if {[info exists answer]} {
                    append answer "\n"
                }
                append answer "echo '$word';"
            }
            if {![info exists answer]} {
                set answer ""
            }
        }
        {tcl} {
            set answer "set _mlstatus \"$val\";"
        }
        {cmd} {
            foreach word $val {
                if {[info exists answer]} {
                    append answer "\n"
                }
                append answer "echo $word"
            }
            if {![info exists answer]} {
                set answer ""
            }
        }
        {python} {
            set answer "_mlstatus = '$val'"
        }
        {ruby} {
            set answer "_mlstatus = '$val'"
        }
        {perl} {
            set answer "{ no strict 'vars'; ${esc}\$_mlstatus = '$val'; }"
        }
        {lisp} {
            set answer "${esc}(message \"$val\"${esc})"
        }
        {cmake} {
            set answer "set${esc}(_mlstatus \"$val\"${esc})"
        }
        {r} {
            set answer "mlstatus <- '$val'"
        }
        {pwsh} {
            set answer "Set-Variable -Name \"_mlstatus\" -Value '$val' -Scope Global"
        }
        default {
            set answer ""
        }
    }

    if {$re_mode} {
        # over escape regexp-special characters
        set answer [regsub -all {([$.+?*\\()&|])} $answer {\\\1}]
    }

    return $answer
}

proc shell_val {test_shell val {re_mode 0} {alias_val 0}} {
    if {$val ne "(.*)"} {
        if {$alias_val && $test_shell in {sh bash ksh zsh fish}} {
            set test_shell a-$test_shell
        }
        switch -- $test_shell {
            {a-sh} - {a-bash} - {csh} - {tcsh} - {a-ksh} - {a-zsh} - {a-fish} {
                set val [regsub -all {([\\"'$|<>{}`*? ()!&;\[\]])} $val {\\\1}]
            }
            {lisp} - {cmake} {
                set val [regsub -all {(["])} $val {\\\1}]
            }
            {sh} - {bash} - {ksh} - {zsh} {
                set val [string map {' '\\''} $val]
            }
            {fish} - {perl} - {python} - {ruby} {
                set val [regsub -all {(['])} $val {\\\1}]
            }
            {r} {
                set val [regsub -all {([\\'])} $val {\\\1}]
            }
        }

        if {$re_mode} {
            # over escape regexp-special characters
            set val [regsub -all {([$.+?*\\()&|])} $val {\\\1}]
        }
    }

    return $val
}

proc shell_set {test_shell var val {re_mode 0} {escval 1}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }

    if {$escval} {
        set val [shell_val $test_shell $val $re_mode]
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} {
            set answer "$var='$val'; export $var;"
        }
        {csh} - {tcsh} {
            set answer "setenv $var $val;"
        }
        {fish} {
            if {$var eq "PATH"} {
                set val [join [split $val :] {' '}]
            }
            set answer "set -xg $var '$val';"
        }
        {tcl} {
            set answer "set ::env${esc}($var${esc}) ${esc}{$val${esc}};"
        }
        {cmd} {
            set answer "set $var=$val"
        }
        {perl} {
            set answer "${esc}\$ENV{'$var'} = '$val';"
        }
        {python} {
            set answer "os.environ${esc}\['$var'${esc}\] = '$val'"
        }
        {ruby} {
            set answer "ENV${esc}\['$var'${esc}\] = '$val'"
        }
        {lisp} {
            set answer "${esc}(setenv \"$var\" \"$val\"${esc})"
        }
        {cmake} {
            set answer "set${esc}(ENV{$var} \"$val\"${esc})"
        }
        {r} {
            set answer "Sys.setenv${esc}('$var'='$val'${esc})"
        }
        {pwsh} {
            set answer "${esc}\$env:$var = '$val'"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_unset {test_shell var {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} {
            set answer "unset $var;"
        }
        {csh} - {tcsh} {
            set answer "unsetenv $var;"
        }
        {fish} {
            set answer "set -e $var;"
        }
        {tcl} {
            set answer "catch {unset ::env${esc}($var${esc})};"
        }
        {cmd} {
            set answer "set $var="
        }
        {perl} {
            set answer "delete ${esc}\$ENV{'$var'};"
        }
        {python} {
            set answer "os.environ${esc}\['$var'${esc}\] = ''\n"
            append answer "del os.environ${esc}\['$var'${esc}\]"
        }
        {ruby} {
            set answer "ENV${esc}\['$var'${esc}\] = nil"
        }
        {lisp} {
            set answer "${esc}(setenv \"$var\" nil${esc})"
        }
        {cmake} {
            set answer "unset${esc}(ENV{$var}${esc})"
        }
        {r} {
            set answer "Sys.unsetenv${esc}('$var'${esc})"
        }
        {pwsh} {
            set answer "Remove-Item -Path env:$var -ErrorAction SilentlyContinue"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_alias {test_shell var val {re_mode 0} {escval 1}} {
    if {$escval} {
        set val [shell_val $test_shell $val $re_mode 1]
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} {
            set answer "alias $var=$val;"
        }
        {csh} - {tcsh} - {fish} {
            set answer "alias $var $val;"
        }
        {cmd} {
            set answer "doskey $var=$val"
        }
        {pwsh} {
            set answer "function global:$var { $val }"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_unalias {test_shell var {re_mode 0}} {
    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} {
            set answer "unalias $var 2>/dev/null || true;"
        }
        {csh} - {tcsh} {
            set answer "unalias $var;"
        }
        {fish} {
            set answer "functions -e $var;"
        }
        {cmd} {
            set answer "doskey $var="
        }
        {pwsh} {
            set answer "Remove-Item -Path function:$var -ErrorAction SilentlyContinue"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_chdir {test_shell val {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
            set answer "cd '$val';"
        }
        {tcl} {
            set answer "cd \"$val\";"
        }
        {cmd} {
            set answer "cd $val"
        }
        {perl} {
            set answer "chdir '$val';"
        }
        {python} {
            set answer "os.chdir${esc}('$val'${esc})"
        }
        {ruby} {
            set answer "Dir.chdir${esc}('$val'${esc})"
        }
        {lisp} {
            set answer "${esc}(shell-command-to-string \"cd '$val'\"${esc})"
        }
        {r} {
            set answer "setwd${esc}('$val'${esc})"
        }
        {pwsh} {
            set answer "Set-Location '$val'"
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_xres {test_shell var val {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }
    set xrdb [auto_execok xrdb]

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
            if {$val ne ""} {
                set answer "echo \"$var: $val\" ${esc}| $xrdb -merge;"
            } else {
                set answer "$xrdb -merge $var;"
            }
        }
        {tcl} {
            if {$val ne ""} {
                set answer "set XRDBPIPE ${esc}\[open \"${esc}|$xrdb -merge\" r${esc}+${esc}\];\n"
                append answer "puts ${esc}\$XRDBPIPE \"$var: $val\";\n"
                append answer "close ${esc}\$XRDBPIPE;\n"
                append answer "unset XRDBPIPE;"
            } else {
                set answer "exec $xrdb -merge $var;"
            }
        }
        {perl} {
            if {$val ne ""} {
                set answer "open${esc}(XRDBPIPE, \"${esc}|$xrdb -merge\"${esc});\n"
                append answer "print XRDBPIPE \"$var: $val${esc}\\n\";\n"
                append answer "close XRDBPIPE;"
            } else {
                set answer "system${esc}(\"$xrdb -merge $var\"${esc});"
            }
        }
        {python} {
            if {$val ne ""} {
                set answer "subprocess.Popen${esc}(${esc}\['$xrdb', '-merge'${esc}\], stdin=subprocess.PIPE${esc}).communicate${esc}(input=\'$var: $val${esc}\\n\'${esc})"
            } else {
                set answer "subprocess.Popen${esc}(${esc}\['$xrdb', '-merge', '$var'${esc}\]${esc})"
            }
        }
        {ruby} {
            if {$val ne ""} {
                set answer "Open3.popen2${esc}('$xrdb -merge'${esc}) {${esc}|i,o,t${esc}| i.puts '$var: $val'}"
            } else {
                set answer "Open3.popen2${esc}('$xrdb -merge $var'${esc})"
            }
        }
        {lisp} {
            if {$val ne ""} {
                set answer "${esc}(shell-command-to-string \"echo $var: $val ${esc}| $xrdb -merge\"${esc})"
            } else {
                set answer "${esc}(shell-command-to-string \"$xrdb -merge $var\"${esc})"
            }
        }
        {cmake} {
            if {$val ne ""} {
                set answer "execute_process${esc}(COMMAND echo \"$var: $val\" COMMAND $xrdb -merge${esc})"
            } else {
                set answer "execute_process${esc}(COMMAND $xrdb -merge $var${esc})"
            }
        }
        {r} {
            if {$val ne ""} {
                set answer "system${esc}('$xrdb -merge', input='$var: $val'${esc})"
            } else {
                set answer "system${esc}('$xrdb -merge $var'${esc})"
            }
        }
        default {
            set answer ""
        }
    }

    return $answer
}

proc shell_unxres {test_shell var {re_mode 0}} {
    if {$re_mode} {
        set esc "\\"
    } else {
        set esc ""
    }
    set xrdb [auto_execok xrdb]

    switch -- $test_shell {
        {sh} - {bash} - {ksh} - {zsh} - {csh} - {tcsh} - {fish} {
            set answer "echo \"$var:\" ${esc}| $xrdb -merge;"
        }
        {tcl} {
            set answer "set XRDBPIPE ${esc}\[open \"${esc}|$xrdb -merge\" r${esc}+${esc}\];\n"
            append answer "puts ${esc}\$XRDBPIPE \"$var:\";\n"
            append answer "close ${esc}\$XRDBPIPE;\n"
            append answer "unset XRDBPIPE;"
        }
        {perl} {
            set answer "open${esc}(XRDBPIPE, \"${esc}|$xrdb -merge\"${esc});\n"
            append answer "print XRDBPIPE \"$var:${esc}\\n\";\n"
            append answer "close XRDBPIPE;"
        }
        {python} {
            set answer "subprocess.Popen${esc}(${esc}\['$xrdb', '-merge'${esc}\], stdin=subprocess.PIPE${esc}).communicate${esc}(input=\'$var:${esc}\\n\'${esc})"
        }
        {ruby} {
            set answer "Open3.popen2${esc}('$xrdb -merge'${esc}) {${esc}|i,o,t${esc}| i.puts '$var:'}"
        }
        {lisp} {
            set answer "${esc}(shell-command-to-string \"echo $var: ${esc}| $xrdb -merge\"${esc})"
        }
        {cmake} {
            set answer "execute_process${esc}(COMMAND echo \"$var:\" COMMAND $xrdb -merge${esc})"
        }
        {r} {
            set answer "system${esc}('$xrdb -merge', input='$var:'${esc})"
        }
        default {
            set answer ""
        }
    }

    return $answer
}


proc shell_out {test_shell out_list {re_mode 0} {auto_status 1}} {
    set answer_list {}
    set fixed_list {}
    array set envvar {}
    array set envalias {}
    array set envxres {}
    array set envunxres {}
    array set autovar {}
    set status_set 0

    foreach out $out_list {
        lassign $out cmd var val extra
        switch -- $cmd {
            {set} {
                if {$extra eq "noescval"} {
                    set escval 0
                } else {
                    set escval 1
                }
                set envvar($var) [shell_set $test_shell $var $val $re_mode $escval]
                lappend answer_list $envvar($var)

                # automatic specification of ref counter var is removed if set
                if {[info exists autovar($var)]} {
                    unset autovar($var)
                }
            }
            {setpath} {
                set envvar($var) [shell_set $test_shell $var $val $re_mode]
                lappend answer_list $envvar($var)

                # automatically set ref counter variable if not specified
                set sharevar __MODULES_SHARE_$var
                if {![info exists envvar($sharevar)]} {
                    if {$re_mode} {
                        set envvar($sharevar) [shell_set $test_shell $sharevar "(.*)" $re_mode]
                    } else {
                        # set a default value when not in re mode
                        set envvar($sharevar) [shell_set $test_shell $sharevar "$val:1" $re_mode]
                    }
                    set autovar($sharevar) 1
                }
            }
            {unset} {
                set envvar($var) [shell_unset $test_shell $var $re_mode]
                lappend answer_list $envvar($var)

                # automatic specification of ref counter var is removed if set
                if {[info exists autovar($var)]} {
                    unset autovar($var)
                }
            }
            {unsetpath} {
                set envvar($var) [shell_unset $test_shell $var $re_mode]
                lappend answer_list $envvar($var)

                # automatically set ref counter variable if not specified
                set sharevar __MODULES_SHARE_$var
                if {![info exists envvar($sharevar)]} {
                    set envvar($sharevar) [shell_unset $test_shell $sharevar $re_mode]
                    set autovar($sharevar) 1
                }
            }
            {alias} {
                set ret [shell_alias $test_shell $var $val $re_mode]
                if {$ret ne ""} {
                    set envalias($var) $ret
                    lappend answer_list $ret
                }
            }
            {unalias} {
                set ret [shell_unalias $test_shell $var $re_mode]
                 if {$ret ne ""} {
                    set envalias($var) $ret
                    lappend answer_list $ret
                }
            }
            {chdir} {
                set ret [shell_chdir $test_shell $var $re_mode]
                if {$ret ne ""} {
                    lappend fixed_list $ret
                    lappend answer_list $ret
                }
            }
            {xres} {
                set ret [shell_xres $test_shell $var $val $re_mode]
                if {$ret ne ""} {
                    set envxres($var) $ret
                    lappend answer_list $ret
                }
            }
            {unxres} {
                set ret [shell_unxres $test_shell $var $re_mode]
                 if {$ret ne ""} {
                    # add element with xres filename as array key for
                    # correct sorting when rendering
                    if {$val ne ""} {
                        if {[info exists envunxres($val)]} {
                            set ret "\n$ret"
                        }
                        append envunxres($val) $ret
                    } else {
                        set envunxres($var) $ret
                    }
                    lappend answer_list $ret
                }
            }
            {text} {
                lappend fixed_list [shell_text $test_shell $var $re_mode]
                lappend answer_list [lindex $fixed_list end]
                set status_set 1
            }
            {OK} {
                lappend fixed_list [shell_ok $test_shell $re_mode]
                lappend answer_list [lindex $fixed_list end]
                set status_set 1
            }
            {ERR} {
                lappend fixed_list [shell_err $test_shell 1 $re_mode]
                lappend answer_list [lindex $fixed_list end]
                set status_set 1
            }
            {ERR2} {
                lappend fixed_list [shell_err $test_shell 2 $re_mode]
                lappend answer_list [lindex $fixed_list end]
                set status_set 1
            }
            {out} {
                lappend fixed_list [join [lrange $out 1 end]]
                lappend answer_list [lindex $fixed_list end]
            }
            default {
                lappend fixed_list [join $out]
                lappend answer_list [lindex $fixed_list end]
            }
        }
    }

    # specific order if var have been automatically set
    if {[array size autovar] || [array size envxres] || [array size\
        envunxres]} {
        set answer_list {}
        foreach var [array names envvar] {
            lappend answer_list $envvar($var)
        }
        foreach var [array names envalias] {
            lappend answer_list $envalias($var)
        }
        if {[array size envxres] || [array size envunxres]} {
            switch -- $test_shell {
                {python} {
                    lappend answer_list "import subprocess"
                }
                {ruby} {
                    lappend answer_list "require 'open3'"
                }
            }
        }
        foreach var [array names envxres] {
            lappend answer_list $envxres($var)
        }
        foreach var [array names envunxres] {
            lappend answer_list $envunxres($var)
        }
        set answer_list [concat $answer_list $fixed_list]
    }


    if {$test_shell eq "python"} {
        set answer_list [concat [list "import os"] $answer_list]
    }

    # add automatic status if any for shell
    if {$auto_status && !$status_set && [llength $answer_list]} {
        lappend answer_list [shell_ok $test_shell $re_mode]
    }

    set answer [join $answer_list "\n"]

    return $answer
}

proc is_shell_out_list {answer} {
    set ret 0

    if {[string is list $answer]} {
        foreach item $answer {
            if {[llength $item] > 1} {
                switch -- [lindex $item 0] {
                    set - setpath - unset - unsetpath - alias - unalias - out\
                    - text - OK {
                        set ret 1
                        break
                    }
                }
            }
        }
    }

    return $ret
}

#
# Test subprocedures
#

proc _test_err {test_shell cmd answer failcmd} {
	global comp_error
	global verbose

    # newline is expected at end of answer
    if {$answer ne {} && $answer ne "\n"} {
        append answer \n
    }
	if { $comp_error != "$answer" } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $comp_error]
		set oe [string length $answer]
		send_user "ERR\[$ol\]: '$comp_error'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_err_re {test_shell cmd answer force_nl failcmd} {
	global comp_error
	global verbose

    # newline is expected at end of answer unless empty or specific regexp set
    if {$force_nl || ($answer ne {} && $answer ne "\n" && $answer ne "^\$" &&\
        $answer ne {.*} && ([string index $answer 0] ne {(} || [string index\
        $answer end] ne {)}))} {
        append answer \n
    }
    set answer "^$answer\$"
	if { ![regexp -- $answer $comp_error] } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $comp_error]
		set oe [string length $answer]
		send_user "ERR\[$ol\]: '$comp_error'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_err_re_sort {test_shell cmd answer failcmd} {
    global comp_error
    global verbose

    # newline is expected at end of answer
    if {$answer ne {} && $answer ne "\n"} {
        append answer \n
    }

    set comp_error_sort [join [lsort [split $comp_error \n]] \n]
    set answer_sort [join [lsort [split $answer \n]] \n]
    set answer_sort "^$answer_sort\$"

	  if {![regexp -- $answer_sort $comp_error_sort]} {
        $failcmd "$cmd ($test_shell)"
        set ol [string length $comp_error_sort]
        set oe [string length $answer_sort]
        send_user "ERR\[$ol\]: '$comp_error_sort'#>\n"
        send_user "EXP\[$oe\]: '$answer_sort'#>\n"
        return 0;
    } else {
        return 1;
    }
}

proc _test_out {test_shell cmd answer failcmd} {
	global comp_output
	global verbose

    if {[is_shell_out_list $answer]} {
        set answer [shell_out $test_shell $answer]
    } elseif {$answer eq "ERR"} {
        set answer [shell_err $test_shell]
    } elseif {$answer eq "ERR2"} {
        set answer [shell_err $test_shell 2]
    } elseif {$answer eq "OK"} {
        # just OK means no output
        set answer ""
    }
    # newline is expected at end of answer
    if {$answer ne {} && $answer ne "\n"} {
        append answer \n
    }

	if { $comp_output != "$answer" } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $comp_output]
		set oe [string length $answer]
		send_user "OUT\[$ol\]: '$comp_output'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_out_re {test_shell cmd answer failcmd} {
	global comp_output
	global verbose

    if {[is_shell_out_list $answer]} {
        set answer [shell_out $test_shell $answer 1]
    } elseif {$answer eq "ERR"} {
        set answer [shell_err $test_shell 1 1]
    } elseif {$answer eq "ERR2"} {
        set answer [shell_err $test_shell 2 1]
    } elseif {$answer eq "OK"} {
        # just OK means no output
        set answer ""
    }
    # newline is expected at end of answer
    if {$answer ne {} && $answer ne "\n" && $answer ne "^\$" && [string index\
        $answer end] ne "\$"} {
        append answer \n
    }

    set answer "^$answer\$"
	if { ![regexp -- $answer $comp_output] } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $comp_output]
		set oe [string length $answer]
		send_user "OUT\[$ol\]: '$comp_output'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_file {test_shell cmd filepath answer failcmd} {
	global verbose

    catch {
        set fd [open $filepath]
        read -nonewline $fd
    } comp_file
    catch { close $fd }

	if { $comp_file != "$answer" } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $comp_file]
		set oe [string length $answer]
		send_user "FILE\[$ol\]: '$comp_file'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_globlist {test_shell cmd fileglob answer failcmd} {
	global verbose

    set globlist [lsort [glob -nocomplain $fileglob]]

	if { $globlist ne $answer } {
		$failcmd "$cmd ($test_shell)"
		set ol [string length $globlist]
		set oe [string length $answer]
		send_user "GLOBLIST\[$ol\]: '$globlist'#>\n"
		send_user "EXP\[$oe\]: '$answer'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_exit {test_shell cmd exitval failcmd} {
	global comp_exit
	global verbose

	if { $comp_exit != "$exitval" } {
		$failcmd "$cmd ($test_shell)"
		send_user "EXIT: '$comp_exit'#>\n"
		send_user "EXP: '$exitval'#>\n"
		return 0;
	} else {
		return 1;
	}
}

proc _test_ok {test_shell cmd} {
	pass "$cmd ($test_shell)"
}

#
# Test procedure for matching with regular expressions
#

proc test_cmd_re {test_shell cmd answer {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            test_cmd_re $shell $cmd $answer
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out_re $test_shell "$cmd" "$answer" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
#  Test procedure for full text matching
#

proc test_cmd {test_shell cmd answer {exitval 0} {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            test_cmd $shell $cmd $answer $exitval
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_exit $test_shell "$cmd" "$exitval" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
# Test procedure for matching with regular expressions in the error output
#

proc testerr_cmd_re {test_shell cmd answer {force_nl 0} {failcmd {fail}}} {
     if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testerr_cmd_re $shell $cmd $answer
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_err_re $test_shell $cmd $answer $force_nl $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
# Test procedure for matching with regular expressions in the stderr/stdout
#

proc testall_cmd_re {test_shell cmd answer anserr exitval {force_nl 0} {failcmd {fail}}} {
    if {$test_shell eq {ALL}} {
        global supported_shells
        foreach shell $supported_shells {
            testall_cmd_re $shell $cmd $answer $anserr $exitval $force_nl $failcmd
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out_re $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_err_re $test_shell "$cmd" "$anserr" $force_nl $failcmd]
        &&   [_test_exit $test_shell "$cmd" "$exitval" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

proc testouterr_cmd_re {test_shell cmd answer anserr {force_nl 0} {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testouterr_cmd_re $shell $cmd $answer $anserr
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out_re $test_shell "$cmd" "$answer" $failcmd]
        && [_test_err_re $test_shell $cmd $anserr $force_nl $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
#  Test procedure for full text matching in the error output
#

proc testerr_cmd {test_shell cmd answer {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testerr_cmd $shell $cmd $answer
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_err $test_shell "$cmd" "$answer" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
# Test procedure for full text matching with the stderr/stdout and text passed to stdin
#

proc testinouterr_cmd {test_shell cmd input answer anserr {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testinouterr_cmd $shell $cmd $input $answer $anserr
        }
    } else {
        _test_sub $test_shell "$cmd" $input
        if { [_test_out $test_shell "$cmd << $input" "$answer" $failcmd]
        &&   [_test_err $test_shell "$cmd << $input" "$anserr" $failcmd] } {
            _test_ok $test_shell "$cmd << $input"
        }
    }
}

#
# Test procedure for full text matching with the stderr/stdout
#

proc testall_cmd {test_shell cmd answer anserr exitval {failcmd {fail}}} {
    if {$test_shell eq {ALL}} {
        global supported_shells
        foreach shell $supported_shells {
            testall_cmd $shell $cmd $answer $anserr $exitval $failcmd
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_err $test_shell "$cmd" "$anserr" $failcmd]
        &&   [_test_exit $test_shell "$cmd" "$exitval" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

proc testouterr_cmd {test_shell cmd answer anserr {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testouterr_cmd $shell $cmd $answer $anserr
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_err $test_shell "$cmd" "$anserr" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
# Test procedure for matching with regular expressions in the stdout and sorted stderr
#

proc testouterr_cmd_re_sort {test_shell cmd answer anserr {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testouterr_cmd_re_sort $shell $cmd $answer $anserr
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out_re $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_err_re_sort $test_shell "$cmd" "$anserr" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

#
# Test procedure for full text matching with stdout and specified file
#

proc testoutfile_cmd {test_shell cmd answer filepath ansfile {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testoutfile_cmd $shell $cmd $answer $filepath $ansfile
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_file $test_shell "$cmd" "$filepath" "$ansfile" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

proc testouterrfile_cmd {test_shell cmd answer anserr filepath ansfile {failcmd {fail}}} {
    if {$test_shell eq "ALL"} {
        global supported_shells
        foreach shell $supported_shells {
            testouterrfile_cmd $shell $cmd $answer $anserr $filepath $ansfile
        }
    } else {
        _test_sub $test_shell "$cmd"
        if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
        &&   [_test_err $test_shell "$cmd" "$anserr" $failcmd]
        &&   [_test_file $test_shell "$cmd" "$filepath" "$ansfile" $failcmd] } {
            _test_ok $test_shell "$cmd"
        }
    }
}

proc testouterrfileglob_cmd {test_shell cmd answer anserr fileglob ansfile {failcmd {fail}}} {
    _test_sub $test_shell "$cmd"
    set filepath [lindex [lsort [glob $fileglob]] end]
    if { [_test_out $test_shell "$cmd" "$answer" $failcmd]
    &&   [_test_err $test_shell "$cmd" "$anserr" $failcmd]
    &&   [_test_file $test_shell "$cmd" "$filepath" "$ansfile" $failcmd] } {
        _test_ok $test_shell "$cmd"
    }
}

#
# Test procedure for full text matching with stdout, stderr and glob file list
#

proc testouterrgloblist_cmd {test_shell cmd answer anserr fileglob ansglob {failcmd {fail}}} {
    if {$test_shell eq {ALL}} {
        global supported_shells
        foreach shell $supported_shells {
            testouterrgloblist_cmd $shell $cmd $answer $anserr $fileglob $ansglob
        }
    } else {
        _test_sub $test_shell $cmd
        if { [_test_out $test_shell $cmd $answer $failcmd]
        &&   [_test_err $test_shell $cmd $anserr $failcmd]
        &&   [_test_globlist $test_shell $cmd $fileglob $ansglob $failcmd] } {
            _test_ok $test_shell $cmd
        }
    }
}

#
# Change and restore file permissions to trigger specific behaviors
#

proc change_file_perms {name perms} {
    global verbose file_orig_perms

    # backup original file permission to restore them later
    set file_orig_perms($name) [file attributes $name -permissions]

    if {$verbose} {
        send_user "\tChange permissions of file $name ($perms)\n"
    }

    # lock file by removing read and execution perms
    file attributes $name -permissions $perms
}

proc restore_file_perms {name} {
    global verbose file_orig_perms

    if {$verbose} {
        send_user "\tRestore permissions of file $name ($file_orig_perms($name))\n"
    }

    # restore file original permissions
    file attributes $name -permissions $file_orig_perms($name)
}

#
# Change environment setup in consistent way
#

proc unsetenv_var {var} {
    if {[info exists ::env($var)]} {
        if {$::verbose} {
            send_user "\tUnset $var\n"
        }
        unset ::env($var)
    }
}

proc unsetenv_path_var {var} {
    unsetenv_var $var
    # unset reference counter variable
    unsetenv_var __MODULES_SHARE_$var
}

proc setenv_var {var val} {
    if {$::verbose} {
        send_user "\tSetup $var = '$val'\n"
    }
    set ::env($var) $val
}

proc setenv_path_var {var args} {
    setenv_var $var [join $args ":"]
    # set reference counter variable
    array set refcnt {}
    foreach arg $args {
        if {![info exist refcnt($arg)]} {
            set refcnt($arg) 1
        } else {
            incr refcnt($arg)
        }
    }
    # remove elements only added once (not to register them in ref count var)
    foreach elt [array names refcnt] {
        if {$refcnt($elt) == 1 && $elt ne {}} {
            unset refcnt($elt)
        }
    }
    if {[array size refcnt]} {
        setenv_var __MODULES_SHARE_$var [join [array get refcnt] ":"]
    } else {
        unsetenv_var __MODULES_SHARE_$var
    }
}

proc unsetenv_loaded_module {} {
    unsetenv_var _LMFILES_
    unsetenv_var LOADEDMODULES
    unsetenv_var __MODULES_LMTAG
}

proc setenv_loaded_module {modlist modfilelist {notaskedmodlist {}}} {
    setenv_var _LMFILES_ [join $modfilelist :]
    setenv_var LOADEDMODULES [join $modlist :]
    if {$notaskedmodlist ne {}} {
        foreach mod $notaskedmodlist {
            lappend altaglist $mod&auto-loaded
        }
        setenv_var __MODULES_LMTAG [join $altaglist :]
    } else {
        unsetenv_var __MODULES_LMTAG
    }
}

# when saving variable ignore internal variable used to perform tests
array set skipped_var [list runtests 1 subdir 1 errorInfo 1 test_counts 1\
    errorCode 1 comp_error 1 dir 1 test_name 1 comp_output 1 comp_exit 1\
    autoinit_mode 1 endpipe 1 saved_var 1 saved_array_var 1 saved_env_var 1\
    env 1 skipped_var 1 auto_execs 1 shell 1 exit_status 1]

# save name and value for any global variables
proc save_test_env {} {
    # reset dump structs
    foreach var [list saved_var saved_array_var saved_env_var] {
        global $var
        if {[info exists $var]} {
            array unset $var
        }
    }

    global env skipped_var

    foreach var [info globals] {
        if {![info exists skipped_var($var)]} {
            if {[array exists ::$var]} {
                set saved_var($var) [array get ::$var]
                set saved_array_var($var) 1
            } else {
                set saved_var($var) [set ::$var]
            }
        }
    }
    send_user "\tSaved test variables: [array names saved_var]\n"
    array set saved_env_var [array get ::env]
    send_user "\tSaved test environment variables: [array names\
        saved_env_var]\n"
}

# restore test environment to its initial saved state
proc reset_test_env {} {
    global saved_var saved_array_var saved_env_var env skipped_var

    # reset Tcl global variables
    foreach var [info globals] {
        if {![info exists skipped_var($var)]} {
            # temp variables should be unset
            if {![info exists saved_var($var)]} {
                lappend unset_list $var
                unset ::$var
            # initial value should be restored if changed
            } elseif {![info exists saved_array_var($var)]} {
                if {$saved_var($var) ne [set ::$var]} {
                    lappend restore_list $var
                    set ::$var $saved_var($var)
                }
            } else {
                if {$saved_var($var) ne [array get ::$var]} {
                    lappend restore_list $var
                    array set ::$var $saved_var($var)
                }
            }
        }
    }
    # unset saved variables should be restored
    foreach var [array names saved_var] {
        if {![info exists ::$var]} {
            lappend restore_list $var
            set ::$var $saved_var($var)
        }
    }

    if {[info exists unset_list]} {
        send_user "\tUnset temp variables: $unset_list\n"
    }
    if {[info exists restore_list]} {
        send_user "\tRestore test variable initial values: $restore_list\n"
    }

    # reset environment variables
    foreach var [array names env] {
        # temp variables should be unset
        if {![info exists saved_env_var($var)]} {
            send_user "\tUnset $var\n"
            unset env($var)
        # initial value should be restored if changed
        } else {
            if {$saved_env_var($var) ne $env($var)} {
                send_user "\tSetup $var = '$saved_env_var($var)'\n"
                set env($var) $saved_env_var($var)
            }
        }
    }
    # unset saved variables should be restored
    foreach var [array names saved_env_var] {
        if {![info exists env($var)]} {
            send_user "\tSetup $var = '$saved_env_var($var)'\n"
            set env($var) $saved_env_var($var)
        }
    }
}

# is quick test mode enabled
proc is_quick_mode {} {
    return [expr {[info exists ::env(QUICKTEST)] && [string is true -strict\
        $::env(QUICKTEST)]}]
}

# if quick test mode is running stop processing of current test file
proc skip_if_quick_mode {} {
    if {[is_quick_mode]} {
        send_user "\tSkipping tests as quick test mode is enabled\n"
        reset_test_env
        return -code 0 -level 2 0
    }
}

proc skip_if_os_in {args} {
    if {$::os_name in $args} {
        send_user "\tSkipping tests for '$::os_name' OS\n"
        reset_test_env
        return -code 0 -level 2 0
    }
}