#!/usr/bin/expect

#
# \brief  Framework for running automated tests
# \author Norman Feske
# \date   2010-03-16
#
# Usage: run --name <run_name> --include <run_script> ...
#
# The '--name' argument is used for as name for the boot-image and
# temporary directories. The files includes via the '--include'
# argument provide platform-specific additions/refinements to the
# test framework as well as the actual test steps.
#


##
# Remove leading and trailing whitespace from string
#
proc strip_whitespace {string} {
	regsub -all {^\s+} $string "" string
	regsub -all {\s+$} $string "" string
	return $string
}


##
# Check if the specified spec requirement is satisfied
#
proc assert_spec {spec} {
	global specs
	if {[lsearch $specs $spec] == -1} {
		puts stderr "Test requires '$spec'"
		exit 0
	}
}


##
# Build genode targets specified as space-separated strings
#
# If the build process fails, this procedure will exit the program with
# the error code -4.
#
proc build {targets} {

	if {[get_cmd_switch --skip-build]} return

	regsub -all {\s\s+} $targets " " targets
	puts "building targets: $targets"
	set timeout 10000
	set pid [eval "spawn make $targets"]
	expect { eof { } }
	if {[lindex [wait $pid] end] != 0} {
		puts "Error: Genode build failed"
		exit -4
	}
	puts "genode build completed"
}


##
# Create a fresh boot directory
#
proc create_boot_directory { } { }


##
# Append string to variable only if 'condition' is satisfied
#
proc append_if {condition var string} {
	global $var
	if {$condition} { append $var $string }
}


##
# Append element to list only if 'condition' is satisfied
#
proc lappend_if {condition var string} {
	global $var
	if {$condition} { lappend $var $string }
}



##
# Install content of specfied variable as init config file
#
proc install_config {config} {
	set fh [open "[run_dir]/genode/config" "WRONLY CREAT TRUNC"]
	puts $fh $config
	close $fh
}


##
# Integrate specified binaries into boot image
#
# \param binaries  space-separated list of file names located within the
#                  '<build-dir>/bin/' directory
#
# This function should be implemented by a platform-specific file
# included via the '--include' argument.
#
proc build_boot_image {binaries} { }


##
# Execute Genode
#
# \param  wait_for_re    regular expression that matches the test completion
# \param  timeout_value  timeout in seconds
# \global output         contains the core output (modified)
#
# If the function is called without any argument, Genode is executed in
# interactive mode.
#
# If the test execution times out, this procedure will exit the program with
# the error code -2.
#
# This function must be implemented by the platform-specific test environment.
# If not implemented, the program exits with the error code -3.
#
proc run_genode_until {{wait_for_re forever} {timeout_value 0}} {
	puts stderr "Error: 'run_genode_until' is not implemented for this platform"
	exit -3
}


##
# Filter output based on the specified pattern
#
# Only those lines that match the pattern are preserved.
#
proc grep_output {pattern} {
	global output
	regsub -all {[\r\n]+} $output "\n" output
	set output_list [split $output "\n"]
	set filtered ""
	foreach line $output_list {
		if {[regexp $pattern $line]} {
			append filtered "$line\n"
		}
	}
	set output $filtered
}


##
# Unify known variations that appear in the test output
#
# \global output test output (modified)
#
proc unify_output {pattern replacement} {
	global output
	regsub -all $pattern $output $replacement output
}


##
# Compare output against expected output line by line
#
# \param  good   expected test output
# \global output test output
#
# This procedure will exit the program with the error code -1 if the
# comparison fails.
#
proc compare_output_to { good } {
	global output
	set output_list [split [strip_whitespace $output] "\n"]
	set good_list   [split [strip_whitespace $good]   "\n"]

	set i 0
	set mismatch_cnt 0
	foreach good_line $good_list {
		set output_line [strip_whitespace [lindex $output_list $i]]
		set good_line   [strip_whitespace $good_line]

		if {$output_line != $good_line} {
			puts ""
			puts stderr "Line $i of output is unexpected"
			puts stderr " expected: '$good_line'"
			puts stderr " got:      '$output_line'"
			incr mismatch_cnt
		}
		incr i
	}

	#
	# if $good is empty the foreach-loop isn't entered
	# so we've to check for it separately
	#
	if {![llength $good_list] && [llength $output_list]} {
		foreach output_line $output_list {
			set output_line [strip_whitespace $output_line]
			puts ""
			puts stderr "Line $i of output is unexpected"
			puts stderr " got:      '$output_line'"
			incr mismatch_cnt
			incr i
		}
	}

	if {$mismatch_cnt > 0} {
		puts "Error: Test failed, $mismatch_cnt unexpected lines of output"
		exit -1
	} else {
		puts "Test succeeded"
	}
}


##
# Return true if command-line switch was specified
#
proc get_cmd_switch { arg_name } {
	global argv
	return [expr [lsearch $argv $arg_name] >= 0]
}


##
# Return command-line argument value
#
# If a argument name is specified multiple times, a
# list of argument values is returned.
#
proc get_cmd_arg { arg_name default_value } {
	global argv

	# find argument name in argv list
	set arg_idx_list [lsearch -all $argv $arg_name]

	if {[llength $arg_idx_list] == 0} { return $default_value }

	set result {}
	foreach arg_idx $arg_idx_list {
		set next_idx [expr $arg_idx + 1]

		# stop if argv ends with the argument name
		if {$next_idx >= [llength $argv]} continue

		# return list element following the argument name
		lappend result [lindex $argv $next_idx]
	}

	# if argument occurred only once, return its value
	if {[llength $result] == 1} { return [lindex $result 0] }

	# if argument occurred multiple times, contain list of arguments
	return $result
}


#
# Read command-line arguments
#

set run_name         [get_cmd_arg --name       "noname"]
set genode_dir       [get_cmd_arg --genode-dir       ""]
set cross_dev_prefix [get_cmd_arg --cross-dev-prefix ""]
set specs            [get_cmd_arg --specs            ""]
set repositories     [get_cmd_arg --repositories     ""]
set qemu_args        [get_cmd_arg --qemu-args        ""]

#
# Enable run scripts to extend 'qemu_arg' via 'append' without bothering
# about the required whitespace in front of the custom arguments.
#
append qemu_args " "

# accessor functions for command-line arguments
proc run_name         { } { global run_name;         return $run_name }
proc run_dir          { } { global run_name;         return var/run/$run_name }
proc genode_dir       { } { global genode_dir;       return $genode_dir }
proc cross_dev_prefix { } { global cross_dev_prefix; return $cross_dev_prefix }

# set expect match-buffer size
match_max -d 20000

##
# Return true if spec value is set for the build
#
proc have_spec {spec} { global specs; return [expr [lsearch $specs $spec] != -1] }


##
# Return true if specified program is installed
#
proc have_installed {program} {
	if {[catch { exec which $program }]} { return false; }
	return true
}


##
# Return true if specified program is installed on the host platform
#
proc requires_installation_of {program} {
	if {![have_installed $program]} {
		puts "Run script aborted because $program is not installed"; exit
	}
}


##
# Return first repository containing the given path
#
proc repository_contains {path} {
	global repositories;
	foreach i $repositories {
		if {[file exists $i/$path]} { return $i }
	}
}


##
## Utilities for performing steps that are the same on several platforms
##

##
# Read kernel location from build-directory configuration
#
# If config file does not exist or if there is no 'KERNEL' declaration in the
# config file, the function returns 'default_location'. If the config file
# points to a non-existing kernel image, the function aborts with the exit
# value -6.
#
proc kernel_location_from_config_file { config_file default_location } {
	global _kernel

	if {![info exists _kernel]} {
		if {[file exists $config_file]} {
			set _kernel [exec sed -n "/^KERNEL/s/^.*=\\s*//p" $config_file]

			# check if the regular expression matched
			if {$_kernel != ""} {
				if {[file exists $_kernel]} {
					return $_kernel
				} else {
					puts stderr "Error: kernel specified in '$config_file' does not exist"
					exit -6
				}
			}
		}

		# try to fall back to version hosted with the Genode build directory
		set _kernel $default_location
	}
	return $_kernel
}


##
# Install files needed to create a bootable ISO image
#
# The ISO boot concept uses isolinux to load GRUB, which in turn loads Genode.
# This way we can make use of isolinux' support for booting ISO images from a
# USB stick.
#
proc install_iso_bootloader_to_run_dir { } {

	exec mkdir -p [run_dir]/boot/isolinux
	exec cp [genode_dir]/tool/boot/chain.c32    [run_dir]/boot/isolinux
	exec cp [genode_dir]/tool/boot/isolinux.bin [run_dir]/boot/isolinux
	exec cp [genode_dir]/tool/boot/isolinux.cfg [run_dir]/boot/isolinux

	exec mkdir -p [run_dir]/boot/grub
	exec cp [genode_dir]/tool/boot/stage2_eltorito [run_dir]/boot/grub
}


##
# Copy the specified binaries from the 'bin/' directory to the run
# directory and try to strip executables.
#
proc copy_and_strip_genode_binaries_to_run_dir { binaries } {

	foreach binary $binaries {
		exec cp bin/$binary [run_dir]/genode
		catch {
			exec [cross_dev_prefix]strip [run_dir]/genode/$binary || true }
	}
}


##
# Create ISO image with the content of the run directory
#
proc create_iso_image_from_run_dir { } {

	puts "creating ISO image..."
	exec rm -f "[run_dir].iso"

	#
	# The 'create_iso' tool returns a non-zero return code even if
	# successful. So we ignore the return code here.
	#
	catch { exec [genode_dir]/tool/create_iso iso ISO=[run_dir] }
	if {![file exists "[run_dir].iso"]} {
		puts stderr "Error: ISO image creation failed"
		exit -5
	}
}


##
# Execute scenario using Qemu
#
proc spawn_qemu { wait_for_re timeout_value } {
	global output
	global qemu_args
	global qemu
	global spawn_id

	if {[have_spec x86_32]} { set qemu "qemu-system-i386" }
	if {[have_spec x86_64]} { set qemu "qemu-system-x86_64" }
	if {[have_spec arm]}    { set qemu "qemu-system-arm" }

	#
	# Only the x86_64 variant of Qemu provides the emulation of hardware
	# virtualization features used by NOVA. So let's always stick to this
	# varient of Qemu when working with NOVA even when operating in 32bit.
	#
	if {[have_spec nova]} { set qemu "qemu-system-x86_64" }

	#
	# Redirect serial output to stdio, but only in graphics mode and no
	# explicit configuration of serial interfaces is specified in the run
	# script. The 'mon' prefix enables the access to the qemu console.
	#
	if {![regexp -- {-nographic} $qemu_args dummy] &&
	    ![regexp -- {-serial}    $qemu_args dummy]} {
	    append qemu_args " -serial mon:stdio " }

	# tweak emulated platform for specific platforms
	if {[have_spec platform_pbxa9]}  { append qemu_args " -M realview-pbx-a9 -m 256 " }
	if {[have_spec platform_vpb926]} { append qemu_args " -M versatilepb     -m 128 " }
	if {[have_spec platform_vea9x4]} { append qemu_args " -M vexpress-a9 -cpu cortex-a9 -m 256 " }

	# on x86, we supply the boot image as ISO image
	if {[have_spec x86]} { append qemu_args " -cdrom [run_dir].iso " }

	# on ARM, we supply the boot image as kernel
	if {[have_spec arm]} { append qemu_args " -kernel [run_dir]/image.elf " }

	set timeout $timeout_value
	set pid [eval "spawn $qemu $qemu_args"]
	if {$wait_for_re == "forever"} { interact $pid }
	expect {
		-re $wait_for_re { }
		timeout { puts stderr "Error: Test execution timed out"; exit -2 }
	}
	set output $expect_out(buffer)
}


##
# Determine terminal program
#
proc terminal { } {
	global env
	if {[info exists env(COLORTERM)]} {
		return $env(COLORTERM)
	}
	return $env(TERM)
}


##
# Determine GDB executable installed at the host
#
proc gdb { } {
	if {[have_installed "[cross_dev_prefix]gdb"]} {
		return "[cross_dev_prefix]gdb" }

	if {[have_installed gdb]} {
		return "gdb" }

	requires_installation_of gdb
}


##
## Execution of run scripts
##

#
# Read and execute files specified as '--include' arguments
#

foreach include_name [get_cmd_arg --include ""] {
	puts "using run script $include_name"
	source $include_name
}