# See the file LICENSE for redistribution information
# 
# Copyright (c) 2002 -2003
# 	Sleepycat Software.  All rights reserved.
#
# $Id: test.tcl,v 1.29 2003/01/21 23:50:12 mjc Exp $
#

source ./include.tcl

load $db_tcllib
load $dbxml_tcllib

if { [file exists $testdir] != 1 } {
	file mkdir $testdir
}

#
# Test if utilities work to figure out the path.  Most systems
# use ., but QNX has a problem with execvp of shell scripts which
# causes it to break.
#
set stat [catch {exec $db_util_path/db_printlog -?} ret]
if { [string first "exec format error" $ret] != -1 } {
	set util_path $db_util_path/.libs
} else {
	set util_path $db_util_path
}

#
# Test if DB XML utilities work to figure out their path.
#
set stat [catch {exec $xmlutil_path/dbxml_dump -?} ret]
if { [string first "exec format error" $ret] != -1 } {
	set xmlutil_path $xmlutil_path/.libs
}

# Xmlparams.tcl is where the list of XML tests is maintained  
# and where those tests and other files needed for XML testing 
# are sourced. 

source $test_path/xmlparams.tcl

# Set variables required to use standard testutils, even if they
# never get exercised by XML.
set dict $db_test_path/wordlist
set encrypt 0
set old_encrypt 0
set passwd test_passwd
set is_qnx_test 0
set gen_upgrade 0
set ohandles {}

# Error stream that (should!) always go to the console, even if we're
# redirecting to ALL.OUT.
set consoleerr stderr

proc run_xmltest { test { args "" } } {
	source ./include.tcl
 	check_handles
	eval $test $args
	xml_verify_dir $testdir "" 1
}

proc run_xml {} {
	global test_names
	source ./include.tcl

	fileremove -f ALL.OUT

	set o [open ALL.OUT a]
	puts -nonewline "XML test run started at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts [dbxml_version]
	puts -nonewline $o "XML test run started at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	puts $o [dbxml_version]
	close $o

	set test_list {
	{"XML"		"xml"}
	}

	# Run with no environment
	foreach pair $test_list {
		set msg [lindex $pair 0]
		set cmd [lindex $pair 1]
		puts "Running $msg tests"
		if [catch {exec $tclsh_path \
		    << "source $test_path/test.tcl; run $cmd" \
		    >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: $cmd test: $res"
			close $o
		}
	}

	# Run under run_tdsmethod (transactional environment)
	puts "Running tests in a transactional environment"
	foreach test $test_names(xml) {
		if [catch {exec $tclsh_path \
		    << "source $test_path/test.tcl; \
		    run_tdsmethod $test" \
		    >>& ALL.OUT } res] {
			set o [open ALL.OUT a]
			puts $o "FAIL: run_tdsmethod $test: $res"
			close $o
		}
	}

	# Run under run_tdsmethod with -thread
	# TODO: test whether berkdb_env supports -thread
	#puts "Running tests in a threaded environment"
	#foreach test $test_names(xml) {
	#	if [catch {exec $tclsh_path \
	#	    << "source $test_path/test.tcl; \
	#	    run_tdsmethod $test thread" \
	#	    >>& ALL.OUT } res] {
	#		set o [open ALL.OUT a]
	#		puts $o "FAIL: run_tdsmethod $test thread: $res"
	#		close $o
	#	}
	#}

	set failed [check_failed_run ALL.OUT]
	set o [open ALL.OUT a]
	if { $failed == 0 } {
		puts "Regression Tests Succeeded"
		puts $o "Regression Tests Succeeded"
	} else {
		puts "Regression Tests Failed; see ALL.OUT for log"
		puts $o "Regression Tests Failed"
	}

	puts -nonewline "Test suite run completed at: "
	puts [clock format [clock seconds] -format "%H:%M %D"]
	puts -nonewline $o "Test suite run completed at: "
	puts $o [clock format [clock seconds] -format "%H:%M %D"]
	close $o
}

proc run { sub args } {
	source ./include.tcl
	global test_names

	if { [info exists test_names($sub)] != 1 } {
		puts stderr "Subsystem $sub has no tests specified in\
		    testparams.tcl; skipping."
	}

	foreach test $test_names($sub) {
		if {[catch {run_xmltest $test} res] != 0 } {
			puts $res
		}
	}	
}

proc check_failed_run { file {text "^FAIL"}} {
	set failed 0
	set o [open $file r]
	while { [gets $o line] >= 0 } {
		set ret [regexp $text $line]
		if { $ret != 0 } {
			set failed 1
		}
	}
	close $o

	return $failed
}

# Run a test in an environment configured for transactional data store.
proc run_envmethod { test {envtype ""} args } {
	source ./include.tcl
	env_cleanup $testdir
	set oflags " -create"

	if { [lsearch -exact $args thread] >= 0 } {
		append oflags " -thread "
	}

	if { $envtype == "tds" || $envtype == "txn" } {
		set envflag "-txn"
	} elseif { $envtype == "cdb" } {
		set envflag "-cdb"
	} elseif { $envtype == "" } {
		set envflag ""
	} else {
		puts "Environment type $envtype not recognized."
	}

	set stat [catch {
		set env [eval {berkdb_env} $oflags $envflag \
		    -mode 0644 -home $testdir -errfile errors.txt]
		error_check_good env_open [is_valid_env $env] TRUE
		append args " -env $env "

		puts "[timestamp]"
		eval $test $args

		flush stdout
		flush stderr
		error_check_good envclose [$env close] 0
		error_check_good envremove [berkdb envremove \
		    -home $testdir] 0
	} res]
	if { $stat != 0} {
		global errorInfo;

		set fnl [string first "\n" $errorInfo]
		set theError [string range $errorInfo 0 [expr $fnl - 1]]
		if {[string first FAIL $errorInfo] == -1} {
			error "FAIL:[timestamp]\
			    run_envmethod with $envtype env: $test: $theError"
		} else {
			error $theError;
		}
	}
}

proc run_tdsmethod { test args } {
	run_envmethod $test txn $args
}

proc run_cdsmethod { test { args "" } } {
	run_envmethod $test cdb $args
}
