# 
# @(#)tcl.tcm.dat	1.6
#
# Copyright 1990, 1997, The Open Group (X/Open)
# Copyright 1990, 1994 Open Software Foundation (OSF)
# Copyright 1990 Unix International (UI)
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation, and that the name of OSF, UI or X/Open not be used in 
# advertising or publicity pertaining to distribution of the software 
# without specific, written prior permission.  OSF, UI and X/Open make 
# no representations about the suitability of this software for any purpose.
# It is provided "as is" without express or implied warranty.
#
# OSF, UI and X/Open DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, 
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO 
# EVENT SHALL OSF, UI or X/Open BE LIABLE FOR ANY SPECIAL, INDIRECT OR 
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF 
# USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR 
# OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 
# PERFORMANCE OF THIS SOFTWARE.
# 
# 
# HISTORY
#
# 6 February 1998, Andrew Josey, The Open Group
# If you supply a variable that holds a string, then the
# Tcl TCM produces a trace back. Additional quoting is
# added to fix this. Bug report as per tet_support 442
#
# 18 November 1997, Andrew Josey, The Open Group
# Fix TET_CODE handling to handle user defined results codes.
# Previously it was fixed to the predefined codes. Also handle
# TET_ABORT properly
#
# 8 November 1997, Andrew Josey, The Open Group
# Make tet_reason consistent with the perl api, i.e. to return
# the reason string or "" otherwise
#
# 22 October 1997, Andrew Josey, The Open Group
# Minor speedups and add tet_delete fix
#
# 15th May 1997, Andrew Josey, The Open Group
# Fix cleanup, startup handling and initialise TET_TMPRES
# file as per suggestion from geoffs
#
# 10th February 1997, Andrew Josey, The Open Group
# Clean up temporary files before exiting
# Apply known bug fixes.
#
# $Log: tcm.tcl.dat,v $
# Revision 1.1.2.5  1994/03/07  23:00:09  rousseau
# 	Fix signal reporting and evaluation problems.
# 	[1994/03/07  22:59:00  rousseau]
#
# Revision 1.1.2.4  1994/03/07  21:35:24  rousseau
# 	Use '-c' option to sh for portability (CR 10085).
# 	[1994/03/07  21:35:08  rousseau]
# 
# Revision 1.1.2.3  1994/02/28  21:48:17  rousseau
# 	Fixed handling of ic list specifiers in tet_scen file.
# 	[1994/02/28  21:48:09  rousseau]
# 
# Revision 1.1.2.2  1994/02/25  22:17:47  rousseau
# 	      Fixed signal handling code.
# 	      [1994/02/25  22:15:05  rousseau]
# 
# Revision 1.1.2.1  1994/02/10  22:54:40  rousseau
# 	      Initial version
# 	      [1994/02/10  22:51:44  rousseau]
# 
# 	      Initial version.
# 	      [1993/12/17  21:03:40  rousseau]
# 
# $EndLog$

# DESCRIPTION:
#       This file contains the support routines for the sequencing and control
#       of invocable components and test purposes.
#       It should be sourced (by means of the tcl "source" command) into a 
#       tcl shell script containing definitions of the invocable components 
#       and test purposes that may be executed, after those definitions have 
#       been made.
#       Test purposes may be written as tcl functions or executable
#       tcl scripts.
#
#       This file sources tetapi.tcl which contains the tcl API functions.
#       Test purposes written as separate tcl scripts must also source
#       tetapi.tcl in order to use those functions.
#
#       The user-supplied tcl variable iclist should contain a list of all
#       the invocable components in the testset;
#       these are named ic1, ic2 ... etc.
#       For each invocable component thus specified, the user should define
#       a variable whose name is the same as that of the component.
#       Each such variable should contain the names of the test purposes
#       associated with each invocable component; for example:
#               iclist="ic1 ic2"
#               ic1="test1-1 test1-2 test1-3"
#               ic2="test2-1 test2-2"
#
#       The NUMBERS of the invocable components to be executed are specified
#       on the command line.
#       In addition, the user may define the variables tet_startup and
#       tet_cleanup; if defined, the related functions (or tcl scripts)
#       are executed at the start and end of processing, respectively.
#
#       The TCM makes the NAME of the currently executing test purpose
#       available in the environment variable tet_thistest.
#
#       The TCM reads configuration variables from the file specified by the
#       TET_CONFIG environment variable; these are placed in the environment
#       and marked as readonly.
#       This file (or the environment) should contain an assignment for
#       TET_NSIG which should be set to one greater than the highest signal
#       number supported by the implementation.
#


# standard signals - may not be specified in TET_SIG_IGN and TET_SIG_LEAVE
set TET_STD_SIGNALS "STD_SIGNAL_LIST"

# signals that are always unhandled
set TET_SPEC_SIGNALS "SPEC_SIGNAL_LIST"

set TET_NSIG TET_NSIG_NUM

#
# TCM global variables
#
set tet_thistest ""

#
# "private" TCM variables
#

#set TET_CWD [exec pwd]
# speedup
set TET_CWD [pwd]
set TET_DELETES $TET_CWD/tet_deletes
trace variable TET_DELETES wu tcl_var_protect
set TET_RESFILE $TET_CWD/tet_xres
trace variable TET_RESFILE wu tcl_var_protect
set TET_STDERR $TET_CWD/tet_stderr
trace variable TET_STDERR wu tcl_var_protect
set TET_TESTS $TET_CWD/tet_tests
trace variable TET_TESTS wu tcl_var_protect
set TET_TMPFILES $TET_CWD/tet_tmpfiles
trace variable TET_TMPFILES wu tcl_var_protect
set TET_TMPRES $TET_CWD/tet_tmpres
trace variable TET_TMPRES wu tcl_var_protect

set TET_BLOCK 0
set TET_CONTEXT 0
set TET_EXITVAL 0
set TET_SEQUENCE 0
set TET_TPCOUNT 0

set TET_CAUGHTSIG 0

set TET_TMP1 $TET_CWD/tet1.[exec sh -c {(:)& echo $!}]
set TET_TMP2 $TET_CWD/tet2.[exec sh -c {(:)& echo $!}]

# ***********************************************************************

#
# "private" TCM function definitions
# these interfaces may go away one day
#

# tet_time - return the time
proc tet_time {} {
    return [clock format [clock seconds] -format %H:%M:%S]
}



# tet_ismember - return 1 if $1 is in the set $2 ...
# otherwise return 0
proc tet_ismember {member args} {
    foreach i $args {
        foreach j $i {
            if {[string compare $member $j] == 0} {
                return 1
            }
        }
    }
    return 0
}


# tet_abandon - signal handler used during startup and cleanup
proc tet_abandon {signal} {
    global TET_EXITVAL

    puts stdout "signal in abandon is $signal"
    if {$signal == 15} {
        tet_sigterm $signal
    } else {
        tet_error Abandoning tetset: caught unexpected signal $signal.
    }
    
    set TET_EXITVAL $signal
    exit
}


# tet_sigterm - signal handler for SIGTERM
proc tet_sigterm {signal} {
    global TET_EXTIVAL
    
    puts stdout "signal in sigterm is $signal"
    if {([catch {set signal}] == 1) || 
        ([string length $signal] == 0)} {
        puts stderr "tet_sigterm: no signal specified"
        exit
    }
    
    tet_error "Abandoning test case: received signal $signal"
    tet_docleanup
    set TET_EXITVAL $signal
    exit
}


# tet_sigskip - signal handler used during test execution
proc tet_sigskip {signal} {
    
    puts stdout "signal in sigskip is $signal"
    if {([catch {set signal}] == 1) || 
        ([string length $signal] == 0)} {
        puts stderr "tet_sigskip: $signal is not defined"
        exit
    }
    
    tet_infoline "unexpected signal $signal received"
    tet_result UNRESOLVED
    if {$signal == 15} {
        tet_sigterm $signal
    }
}


# tet_tpend - report on a test purpose
proc tet_tpend {test_name} {
    global TET_TMPRES TET_NEXTRES TET_RESULT TET_RESNUM
    
    if {([catch {set test_name}] == 1) || 
        ([string length $test_name] == 0)} {
        puts stderr "tet_tpend: no test_name specified"
        exit
    }
    
    set fd [open $TET_TMPRES r]
    seek $fd 0
    
    set TET_RESULT ""
    while {![eof $fd]} {
        set TET_NEXTRES [gets $fd]

        if {[string length $TET_NEXTRES] == 0} {
            continue
        }

        if {[string length $TET_RESULT] == 0} {
            set TET_RESULT $TET_NEXTRES
            continue
        }
        
        switch $TET_NEXTRES {
            PASS {
            }
            FAIL {
                set TET_RESULT $TET_NEXTRES
            }
            UNRESOLVED -
            UNINITIATED {
                if {$TET_RESULT != "FAIL"} {
                    set TET_RESULT $TET_NEXTRES
                }
            }
            NORESULT {
                if {($TET_RESULT != "FAIL") && 
                    ($TET_RESULT != "UNRESOLVED") &&
                    ($TET_RESULT != "UNINITIATED")} {
                    set TET_RESULT $TET_NEXTRES
                }
            }
            UNSUPPORTED -
            NOTINUSE -
            UNTESTED {
                if {$TET_RESULT == "PASS"} {
                    set TET_RESULT $TET_NEXTRES
                }
            }
            default {
                if {($TET_RESULT == "PASS") ||
                    ($TET_RESULT == "UNSUPPORTED") ||
                    ($TET_RESULT == "NOTINUSE") || 
                    ($TET_RESULT == "UNTESTED")} {
                    set TET_RESULT $TET_NEXTRES
                }
            }
        }
    }

    close $fd

    global TET_ABORT   # for passing between functions
    set TET_ABORT NO
    set TET_RESNUM -1
    if {[string length $TET_RESULT] == 0} {
        set TET_RESULT NORESULT
        set TET_RESNUM 7
    } elseif {![tet_getcode $TET_RESULT]} {
        # tet_getcode should set TET_RESNUM and TET_ABORT
    } else {
        set TET_RESULT "NO RESULT NAME"
        set TET_RESNUM -1
    }
    
    tet_output 220 "$test_name $TET_RESNUM [tet_time]" $TET_RESULT
    
    if {$TET_ABORT == "YES"} {
        set TET_TRAP_FUNCTION tet_abandon
        
        tet_output 510 "" "ABORT on result code $TET_RESNUM \"$TET_RESULT\""
        
        tet_docleanup
        
        set TET_EXITVAL 1
        exit
    }
}


# tet_docleanup - execute the tet_cleanup function
proc tet_docleanup {} {
  global tet_thistest TET_TPCONT TET_BLOCK tet_cleanup

  set tet_thistest ""
  set TET_TPCOUNT 0
  set TET_BLOCK 0
  tet_setblock
  if {[string length $tet_cleanup] > 0} {
  	eval $tet_cleanup
  }
}


# tet_var_protect - write and unset reace for read-only variables
proc tet_var_protect {name element op} {
  puts stderr "Error: $name is a read-only variable."
  exit
}


# ***********************************************************************

# read in API functions
set TET_ROOT $env(TET_ROOT)

if {([catch {set TET_ROOT}] == 1) || 
    ([string length TET_ROOT] == 0)} {
  puts stderr "tcm_main: TET_ROOT not defined"
  exit
}

source $env(TET_ROOT)/lib/tcl/tetapi.tcl


# ***********************************************************************

#
# TCM main flow
#

# capture command line args before they disappear
set TET_TCM_ARGC $argc
set TET_TCM_ARGS $argv
set TET_PNAME $argv0

# arrange to clean up on exit
exec rm -f $TET_TMPFILES
rename exit dcecp_internal_exit
proc exit {{status 0}} {
    global TET_TMPFILES TET_EXITVAL

    if {[catch {exec cat $TET_TMPFILES} msg]} {
        set TET_TMPFILELIST ""
    } else {
        set TET_TMPFILELIST $msg
    }

    regsub -all \n $TET_TMPFILELIST " " TET_TMP
    
    foreach TET_TMP2 [concat $TET_TMP $TET_TMPFILES] {
        exec rm $TET_TMP2
    }
    
    dcecp_internal_exit $TET_EXITVAL
}
signal trap {1 2 3 15} {set TET_EXITVAL 1;exit}

# zero and open execution results file
if {[catch {exec touch $TET_RESFILE} msg]} {
    set TET_EXITVAL 1
    exit
}

set TET_TMP [concat $TET_DELETES $TET_STDERR $TET_TESTS $TET_TMP1 $TET_TMPRES]
foreach TET_A $TET_TMP {
    exec rm -rf $TET_A
    exec echo $TET_A >> $TET_TMPFILES
    exec touch $TET_A
}

# The long and winding road to the TET_CONFIG file...
if {[catch {set TET_CONFIG $env(TET_CONFIG)}] == 0} {
    if {![file readable $TET_CONFIG]} {
        tet_error Can not read config file ${TET_CONFIG}.
    } else {
        # Read through TET_CONFIG file and rewrite into a format
        # that we (Tcl) can understand.
        set fd [open $TET_CONFIG r]
        
        while {![eof $fd]} {
            set line [gets $fd]

            set var_index [string first "=" $line]
            if {$var_index == -1} {
                continue
            }

            set var [string range $line 0 [expr $var_index - 1]]
            set value [string range $line [expr $var_index + 1] end]
            exec echo set $var \"$value\" >> $TET_TMP1
        }
            
        close $fd
        set TET_CONFIG $TET_TMP1
        source ${TET_CONFIG}
    }
}


# set current context to process ID
tet_setcontext

# set up default results code file if so required
if {[catch {set $TET_CODE}]} {
#    set TET_CODE tet_code
# AJ 18/11/97 set TET_CODE from the environment passed by tcc
    set TET_CODE $env(TET_CODE)
    if {![file readable $TET_CODE]} { # only set the defaults if the file is not readable
        if {$TET_CODE != "tet_code"} {
            tet_error "could not open results code file" $TET_CODE
        }

    exec echo $TET_TMP2 >> $TET_TMPFILES
    exec echo "
0       PASS            Continue
1       FAIL            Continue
2       UNRESOLVED      Continue
3       NOTINUSE        Continue
4       UNSUPPORTED     Continue
5       UNTESTED        Continue
6       UNINITIATED     Continue
7       NORESULT        Continue" > $TET_TMP2

    set TET_CODE $TET_TMP2
    }
}

switch -regexp $TET_CODE {
    ^/ {
    }
    default {
#        set TET_CODE "[exec pwd]/$TET_CODE"
        set TET_CODE "[pwd]/$TET_CODE"
   }
}

# process command-line args
if {1 > $TET_TCM_ARGC} {
    set TET_TCM_ARGS all
}

set TET_ICLAST -1
set TET_ICLIST [exec echo $iclist | tr -cd { 0123456789}]

if {[string length $TET_ICLIST] == 0} {
    set TET_ICLIST 0
}

set TET_ICFIRST_DEF [exec echo $TET_ICLIST | sed {s/ .*//}]
set TET_TMP [exec echo $TET_TCM_ARGS | tr , " "]
foreach TET_A $TET_TMP {
    switch -regexp $TET_A {
        all* {
            if {0 >= $TET_ICLAST} {
                set TET_ICFIRST $TET_ICFIRST_DEF
                foreach TET_B $TET_ICLIST {
                    if {$TET_B <= $TET_ICFIRST} {
                        set TET_ICFIRST $TET_B
                    }
                }
            } else {
                incr TET_ICLAST
            }
            
            set TET_ICLAST $TET_ICFIRST

            foreach TET_B $TET_ICLIST {
                if {$TET_B > $TET_ICLAST} {
                    set TET_ICLAST $TET_B
                }
            }

            if {([catch {set TET_B}] == 1) || 
                ([string length $TET_B] == 0)} {
                set TET_B 0
            }
            
            if {$TET_ICLAST > $TET_B} {
                set TET_ICLAST $TET_B
            }
        }
        default {
            set TET_TMP [exec echo $TET_A | sed {h; s/^\([0-9]*\).*/set TET_ICFIRST \1/; p; g; s/^[^\-]*-*//; s/^\([0-9]*\).*/set TET_ICLAST X\1/}]
            eval $TET_TMP
            if {$TET_ICLAST == "X"} {
                set TET_ICLAST -1
            } else {
                set TET_ICLAST [string range $TET_ICLAST 1 end]
            }
        }
    }

    if {[string length $TET_ICFIRST] == 0} {
        set TET_ICNO $TET_ICFIRST_DEF
    } else {
        set TET_ICNO $TET_ICFIRST
    }
 
    if {[string length $TET_ICLAST] == 0} {
        set TET_ICLAST $TET_ICNO
    }
    
    if {$TET_ICLAST == -1} {
        set TET_ICLAST $TET_ICNO
    }

    while {$TET_ICNO <= $TET_ICLAST} {
        if {[tet_ismember $TET_ICNO $TET_ICLIST]} {
            set TET_TMP ic$TET_ICNO
            if {[string length $TET_TMP] > 0} {
                exec echo ic$TET_ICNO >> $TET_TESTS
            }
        } else {
            tet_error "IC $TET_ICNO is not defined for this test case"
        }
            
        incr TET_ICNO
    }
}
exec cat $TET_TESTS

set TET_ICCOUNT [exec wc -l < $TET_TESTS | tr -cd {0123456789}]

# print startup message to execution results file
tet_output 15 "3.1 $TET_ICCOUNT" "TCM Start"

# do initial signal list processing

if {[catch {set TET_SIG_LEAVE}]} {
    set TET_SIG_LEAVE ""
}
if {[catch {set TET_SIG_IGN}]} {
    set TET_SIG_IGN ""
}


set TET_SIG_LEAVE2 ""
set TET_SIG_IGN2 ""
set TET_TMP "TET_SIG_LEAVE TET_SIG_IGN"
foreach TET_A $TET_TMP {
    set TMP_SIG_LIST [set $TET_A]
    set TET_TMP [exec echo $TMP_SIG_LIST | tr , {\012}]
    foreach TET_TMP2 $TET_TMP {
        set TET_B [lindex $TET_TMP2 0]
        if {[string length $TET_B] == 0} {
            continue;
        } elseif {[tet_ismember $TET_B $TET_STD_SIGNALS $TET_SPEC_SIGNALS]} {
            tet_error "warning: illegal entry $TET_B in $TET_A ignored"
        } else {
            set ${TET_A}2 "[set ${TET_A}2] $TET_B"
        }
    }
}

set TET_SIG_LEAVE2 "$TET_SIG_LEAVE2 $TET_SPEC_SIGNALS"
set TET_A 1
if {([catch {set TET_NSIG}]) || ([string length $TET_NSIG] == 0)} {
    puts stderr "TET_NSIG: Variable is null or not set"
    exit
}

set TET_TRAP_FUNCTION tet_abandon
set TET_DEFAULT_SIGS ""

while {$TET_A < $TET_NSIG} {
    if {[tet_ismember $TET_A $TET_SIG_LEAVE2]} {
    } elseif {[tet_ismember $TET_A $TET_SIG_IGN2]} {
        signal ignore $TET_A
    } elseif {[tet_ismember $TET_A $TET_STD_SIGNALS]}  {
       	    signal trap $TET_A "signal ignore $TET_A; $TET_TRAP_FUNCTION $TET_A"
            set TET_DEFAULT_SIGS "$TET_DEFAULT_SIGS $TET_A"
    } 
    incr TET_A
}

# do startup processing
if {[string length $tet_startup] > 0} {
	eval $tet_startup
}

# do main loop processing
set TET_TMP [exec cat $TET_TESTS]
foreach TET_ICNAME $TET_TMP {
    set TET_TPLIST [set $TET_ICNAME]
    set TET_ICNUMBER [exec echo $TET_ICNAME | tr -cd '0123456789']
    set TET_TPCOUNT [llength $TET_TPLIST]
    tet_output 400 "$TET_ICNUMBER $TET_TPCOUNT [tet_time]" "IC Start"
    set TET_TPCOUNT 0
    
    foreach tet_thistest $TET_TPLIST {
        incr TET_TPCOUNT
        tet_output 200 "$TET_TPCOUNT [tet_time]" "TP Start"

# 970513 geoffs: Initialise TET_TMPRES file
        exec cp /dev/null $TET_TMPRES     

# tp deleted ?
	if { [tet_reason $tet_thistest] != "" } {
            tet_infoline [eval tet_reason $tet_thistest]
            tet_result UNINITIATED
        } else {
            set TET_TRAP_FUNCTION tet_sigskip
            # signal trap $TET_DEFAULT_SIGS 
            
            set TET_TMP [set tet_thistest]
            # Run the test
            [set TET_TMP]
        }
        tet_tpend $TET_TPCOUNT
    }
    tet_output 410 "$TET_ICNUMBER $TET_TPCOUNT [tet_time]" "IC End"
}

# do cleanup processing
set TET_TRAP_FUNCTION tet_abandon

if {[string length $tet_cleanup] > 0} {
  	eval $tet_cleanup
}

#
# Cleanup temporary files before exit
#
set TET_B [exec cat $TET_TMPFILES]
set TET_B [concat $TET_TMPFILES $TET_B]
foreach TET_A $TET_B {
    exec rm -rf $TET_A
}     
# successful exit
set TET_EXITVAL 0