genode/repos/os/run/test.run

#
# Execute a single test defined in a pkg recipe
#
# This run script executes a single test case as a static system scenario.
# It is meant as a handy tool for quickly reproducing, instrumenting, and
# debugging test cases without the need to create/use any depot archives.
#
# The run script combines the information found in the test's runtime
# definition with the following parameters and heuristics:
#
# - The test must be specified via the 'PKG' environment variable.
#   The specified value is used to find the matching pkg recipe within the
#   source tree. Therecipe must feature a 'runtime' definition as normally
#   used by the depot autopilot.
#
# - The run script scans the source tree for 'target.mk' files and the target
#   names defined via the 'TARGET = <name>' definition within those files.
#   The information is used to determine the correspondence between the
#   target's binary name and its build path (the location of the 'target.mk'
#   within the src/ directory). Note that ambiguities are not handled, e.g.,
#   multiple 'target.mk' files with the same TARGET name will likely cause
#   problems.
#
# - Based on the <content> information found in the test's runtime file,
#   the build targets and boot modules required by the test are determined
#   automatically.
#
# - The test's configuration is expected to have the form of a <config>
#   node in the test's runtime file.
#
# - The success/failure criterion is taken from the runtime's <events>
#   definition but only a subset of the depot-autopilot's features is
#   supported, namely a timeout (indicating a failure) and an expected log
#   (indicating success). If this information are not present, the test
#   is executed forever.
#
# For an example, issue the following command from your build directory:
#
#   make run/test KERNEL=linux PKG=test-fs_report
#

##
# Obtain name of the test pkg from the 'PKG' environment variable
#
proc pkg_name { } {

	global ::env

	if {![info exists ::env(PKG)]} {
		puts stderr "Error: environment variable 'PKG' not defined"
		exit 1
	}
	return $::env(PKG)
}

if {[catch {
	set pkg_recipe [glob "[genode_dir]/repos/*/recipes/pkg/[pkg_name]"]
}]} {
	puts stderr "Error: unable to find 'recipes/pkg/[pkg_name]' in repos"
	exit 1
}


##
# Collect content of the raw archives as used by the test
#
# This function returns a list of file paths that must be added as ROM modules
# to the boot image.
#
# Note that it does not evaluate the 'content.mk' file of the raw recipes but
# relies on the convention that the content of raw archives is hosted at the
# raw archive's recipe location.
#
# The function does not traverse nested pkg archives because no test uses this
# feature of pkg archives.
#
proc _files_from_raw_archives { archives_file } {

	if {![file exists $archives_file]} {
		puts stderr "Warning: $archives_file does not exist"
		return { }
	}

	set fh [open $archives_file "r"]
	set archives [split [read $fh] "\n"]
	close $fh

	set result { }

	foreach archive $archives {

		if {![regexp [_depot_archive_path_pattern] $archive dummy user type name]} {
			continue }

		if {$type != "raw"} {
			continue }

		if {[catch {
			set raw_recipe [glob "[genode_dir]/repos/*/recipes/raw/$name"]
			set files [glob "$raw_recipe/*"]
			foreach file $files {
				if {[string match "*/content.mk" $file]} { continue }
				if {[string match "*/hash"       $file]} { continue }
				lappend result $file
			}
		}]} {
			puts stderr "Warning: cannot obtain content of raw archive $name"
		}
	}
	return $result
}

set files_from_raw_archives [_files_from_raw_archives $pkg_recipe/archives]


##
# Return true if ROM module is provided by a raw archive
#
proc rom_module_from_raw_archive { rom } {

	global files_from_raw_archives

	foreach file $files_from_raw_archives {
		if {[string match "*/$rom" $file]} {
			return 1; } }

	return 0;
}


#
# Extract information from the test's runtime file
#

set runtime_file $pkg_recipe/runtime

if {![file exists $runtime_file]} {
	puts stderr "Error: $pkg_recipe lacks 'runtime' definition"
	exit 1
}

proc query_attr { node_path attr_name xml_file }  {

	set xpath "$node_path/attribute::$attr_name"
	set attr_value [exec xmllint --xpath $xpath $xml_file]

	# in the presence of multiple matching xpaths, return only the first
	regexp {"(.*)"} [lindex $attr_value 0] dummy value
	return $value;
}

proc query_node { node_path xml_file }  {

	set xpath "$node_path"
	set content [exec xmllint --xpath $xpath $xml_file]

	return $content;
}

proc try_query_attr_from_runtime { attr } {

	global runtime_file

	if {[catch {
		set result [query_attr /runtime $attr $runtime_file]
	}]} {
		puts stderr "Error: missing '$attr' attribute in <runtime> at $runtime_file"
		exit 1
	}
	return $result
}

set ram    [try_query_attr_from_runtime ram]
set caps   [try_query_attr_from_runtime caps]
set binary [try_query_attr_from_runtime binary]

if {[catch {
	set config [query_node /runtime/config $runtime_file]
}]} {
	puts stderr "Error: <config> not present <runtime> sub node at $runtime_file"
	puts stderr "       The use of an separate config ROM is not supported."
	exit 1
}

proc desanitize_xml_characters { string } {
	regsub -all {&gt;} $string {>} string
	regsub -all {&lt;} $string {<} string
	return $string
}

set config [desanitize_xml_characters $config]


#
# Gather the source locations of all targets found in the source tree to
# define the build targets and boot modules required by the test.
#
set target_mks [exec sh -c "cd [genode_dir]/repos; \
                              grep \"TARGET.*=\" `find -name target.mk`"]

foreach target_mk [split $target_mks "\n"] {
	regsub {^.*?/src/} $target_mk {} target_mk

	if {[regexp {(.+?)/target.mk.*\s([^\s]+)\s*$} $target_mk dummy target_path target_name]} {
		set src_sub_dir($target_name) $target_path
	}
}

proc content_rom_modules { } {

	global runtime_file

	set attributes [query_node "/runtime/content/rom/attribute::label" $runtime_file]

	set rom_names {}
	foreach attr $attributes {
		regexp {"(.*)"} $attr dummy rom_name
		lappend rom_names $rom_name
	}
	return $rom_names
}

foreach rom [content_rom_modules] {

	# handle vfs plugin shared-object targets
	if {[regexp "^(.+).lib.so$" $rom dummy plugin]} {
		lappend build_targets lib/$plugin
		continue
	}

	if {[info exists src_sub_dir($rom)]} {
		lappend build_targets $src_sub_dir($rom)
	}
}


#
# Build
#

lappend build_targets core init timer lib/ld

# strip duplications
set sorted_build_targets [lsort -unique $build_targets]

build $sorted_build_targets


#
# Configure and assemble boot image
#

create_boot_directory

foreach file $files_from_raw_archives {
	copy_file $file [run_dir]/genode/ }

install_config {
	<config prio_levels="2">
		<parent-provides>
			<service name="ROM"/>
			<service name="IRQ"/>
			<service name="IO_MEM"/>
			<service name="IO_PORT"/>
			<service name="PD"/>
			<service name="RM"/>
			<service name="CPU"/>
			<service name="LOG"/>
			<service name="TRACE"/>
		</parent-provides>

		<start name="timer" caps="100">
			<resource name="RAM" quantum="1M"/>
			<provides><service name="Timer"/></provides>
			<route>
				<service name="PD">      <parent/> </service>
				<service name="CPU">     <parent/> </service>
				<service name="LOG">     <parent/> </service>
				<service name="ROM">     <parent/> </service>
				<service name="IO_MEM">  <parent/> </service>
				<service name="IRQ">     <parent/> </service>
				<service name="IO_PORT"> <parent/> </service>
			</route>
		</start>

		<start name="test" priority="-1" caps="} $caps {">
			<resource name="RAM" quantum="} $ram {"/>
			<binary name="} $binary {"/>
			<route>
				<service name="ROM">   <parent/>    </service>
				<service name="PD">    <parent/>    </service>
				<service name="RM">    <parent/>    </service>
				<service name="CPU">   <parent/>    </service>
				<service name="LOG">   <parent/>    </service>
				<service name="TRACE"> <parent/>    </service>
				<service name="Timer"> <child name="timer"/> </service>
			</route>
			} $config {
		</start>
	</config>
}

build_boot_image [build_artifacts]


##
# Return failure timeout in seconds
#
proc query_failure_timeout { } {

	global runtime_file

	set sec 0
	catch { set sec [query_attr /runtime/fail after_seconds $runtime_file] }
	return $sec
}

set failure_timeout [expr [query_failure_timeout] + 10]


##
# Return regexp pattern to match the log output for detecting the success
#
proc query_expected_log_pattern { } {

	global runtime_file

	set log ""
	catch {
		set log [query_node "/runtime/succeed/child::text()" $runtime_file]
	} { return "" }

	# strip leading and trailing whitespace
	regsub {^\s*} $log {} log
	regsub {\s*$} $log {} log

	# filter pattern line by line
	set lines [split $log "\n"]

	set prefixed_lines { }
	foreach line $lines {
		regsub {^\s*\[init} $line {[init -> test} line

		set line [desanitize_xml_characters $line]

		# quote regexp characters
		foreach char [list {[} {]} {(} {)} {.}] {
			regsub -all "\\$char" $line "\\$char" line }

		# replace wildcards by non-greedy regexp wildcards
		regsub -all {\*} $line {.*?} line

		lappend prefixed_lines "$line.*?"
	}

	set joined [join $prefixed_lines "\n"]
	return ".*?$joined.*?"
}

set expected_pattern [query_expected_log_pattern]

if {$expected_pattern == ""} {
	puts stderr "Warning: unable to obtain expected log pattern from $runtime_file"
	run_genode_until {^this-should=never-match$} $failure_timeout
}

if {$failure_timeout == 0} {
	puts stderr "Warning: could not determine failure timeout, discharge timeout"
	set failure_timeout 1000
}

append qemu_args " -nographic "

run_genode_until $expected_pattern $failure_timeout