testing/tcl_commands: test target create, cget, configure

Introduce basic testing of error-handling in target configuration
related commands.

The tests can be run via `make check` when JTAG `dummy` adapter is
enabled.

Change-Id: Id0f382046dd70007d8e696d82d2396a7ccab7a33
Signed-off-by: Evgeniy Naydanov <evgeniy.naydanov@syntacore.com>
Reviewed-on: https://review.openocd.org/c/openocd/+/8644
Tested-by: jenkins
Reviewed-by: Antonio Borneo <borneo.antonio@gmail.com>

Makefile.am

@@ -10,7 +10,7 @@ AUTOMAKE_OPTIONS = gnu 1.6
 AM_DISTCHECK_CONFIGURE_FLAGS = --disable-install-jim
 
 # do not run Jim Tcl tests (esp. during distcheck)
-check-recursive: SUBDIRS :=
+check-recursive: SUBDIRS := $(SUBDIRS:jimtcl=)
 
 nobase_dist_pkgdata_DATA = \
 	contrib/libdcc/dcc_stdio.c \
@@ -36,6 +36,9 @@ EXTRA_DIST += jimtcl/configure.gnu
 DISTCLEANFILES += jimtcl/jsmn/jsmn.o
 endif
 
+SUBDIRS += testing
+DIST_SUBDIRS += testing
+
 # common flags used in openocd build
 AM_CFLAGS = $(GCC_WARNINGS)
 AM_LDFLAGS =

configure.ac

@@ -835,7 +835,9 @@ AS_IF([test "x$gcc_warnings" = "xyes"], [
 AC_SUBST(EXTRA_DIST_NEWS, ["$(echo $srcdir/NEWS-*)"])
 
 AC_CONFIG_FILES([
-  Makefile
+  Makefile \
+  testing/Makefile \
+  testing/tcl_commands/Makefile
 ])
 AC_OUTPUT
 

testing/Makefile.am

@@ -0,0 +1,4 @@
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+SUBDIRS = tcl_commands
+DIST_SUBDIRS = tcl_commands

testing/tcl_commands/Makefile.am

@@ -0,0 +1,15 @@
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+TESTS =
+
+if DUMMY
+TESTS += \
+	test-target-create-command.cfg \
+	test-target-configure-cget-command.cfg
+endif
+
+EXTRA_DIST = utils.tcl $(TESTS)
+
+TEST_EXTENSIONS = .cfg
+CFG_LOG_COMPILER = $(top_builddir)/src/openocd
+AM_CFG_LOG_FLAGS = -f $(abs_srcdir)/utils.tcl -f

testing/tcl_commands/test-target-configure-cget-command.cfg

@@ -0,0 +1,31 @@
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+namespace import testing_helpers::*
+namespace import configure_testing::*
+
+adapter driver dummy
+jtag newtap tap cpu -irlen 5
+
+{*}[target_create_first_args] {*}[simple_configure_options]
+
+set target_name [lindex [target names] 0]
+
+check_matches testee {$target_name cget -type}
+
+foreach {opt arg} [simple_configure_options] {
+	check_syntax_err {$target_name cget $opt extra_arg}
+	check_matches [dict get [simple_configure_options] $opt] \
+		{$target_name cget $opt}
+}
+
+check_error_matches .*-event.* {$target_name cget -event}
+$target_name cget -event examine-start
+check_syntax_err {$target_name cget -event examine-start extra_arg}
+
+check_syntax_err {$target_name configure}
+
+foreach {opt arg} [simple_configure_options] {
+	$target_name configure $opt [$target_name cget $opt]
+}
+
+shutdown

testing/tcl_commands/test-target-create-command.cfg

@@ -0,0 +1,54 @@
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+namespace import testing_helpers::*
+namespace import configure_testing::*
+
+adapter driver dummy
+jtag newtap tap cpu -irlen 5
+
+check_syntax_err {target create}
+check_syntax_err {target create}
+check_syntax_err {target create test.target}
+check_error_matches -chain-position {target create test.target testee}
+
+{*}[target_create_first_args] {*}[simple_configure_options]
+
+foreach {opt arg} [simple_configure_options] {
+	check_error_matches ".*${opt}.*" {{*}[target_create_first_args] $opt}
+}
+
+foreach {opt1 arg1} [simple_configure_options] {
+	foreach {opt2 arg2} [simple_configure_options] {
+		check_error_matches ".*${opt2}.*" \
+			{{*}[target_create_first_args] $opt1 $arg1 $opt2}
+		check_error_matches {} \
+			{{*}[target_create_first_args] $opt1 $opt2 $arg2}
+	}
+}
+
+check_error_matches ".*-type.*" \
+	{{*}[target_create_first_args] -type}
+
+check_error_matches ".*-type.*" \
+	{{*}[target_create_first_args] {*}[simple_configure_options] -type}
+
+check_error_matches {.*-event [^ ]+ .*} \
+	{{*}[target_create_first_args] -event}
+
+check_error_matches {.*not-an-event.*} \
+	{{*}[target_create_first_args] -event not-an-event}
+
+check_error_matches {.*-event examine-start [^ ]+.*} \
+	{{*}[target_create_first_args] -event examine-start}
+
+{*}[target_create_first_args] {*}[simple_configure_options] \
+	-event examine-start body
+{*}[target_create_first_args] {*}[simple_configure_options] \
+	-event examine-start body \
+	-event examine-end another-body \
+	-event examine-start new-body
+{*}[target_create_first_args] -event examine-start body {*}[simple_configure_options]
+
+{*}[target_create_first_args] {*}[simple_configure_options] -defer-examine
+
+shutdown

testing/tcl_commands/utils.tcl

@@ -0,0 +1,80 @@
+# SPDX-License-Identifier: GPL-2.0-or-later
+
+namespace eval testing_helpers {
+
+	proc test_failure message {
+		echo $message
+		shutdown error
+	}
+
+	proc check_for_error {expctd_code msg_ptrn script} {
+		set code [catch {uplevel $script} msg]
+		set expanded_script [uplevel subst \"$script\"]
+		if {!$code} {
+			test_failure \
+				"'$expanded_script' finished successfully. \
+				Was expecting an error."
+		}
+		if {$expctd_code ne "" && $code != $expctd_code} {
+			test_failure \
+				"'$expanded_script' returned unexpected error code $code. \
+				Was expecting $expctd_code. Error message: '$msg'"
+		}
+		if {$msg_ptrn ne "" && ![regexp -- $msg_ptrn $msg]} {
+			test_failure \
+				"'$expanded_script' returned unexpected error message '$msg'. \
+				Was expecting '$msg_ptrn'. Error code: $code"
+		}
+	}
+
+	proc check_error_matches {pattern script} {
+		tailcall check_for_error {} $pattern $script
+	}
+
+	proc check_syntax_err script {
+		tailcall check_for_error -601 {} $script
+	}
+
+	proc check_matches {pattern script} {
+		set result [uplevel $script]
+		if {[regexp $pattern $result]} {return}
+		test_failure \
+			"'$script' produced unexpected result '$result'. \
+			Was expecting '$pattern'."
+	}
+
+	namespace export check_error_matches check_syntax_err check_matches
+}
+
+namespace eval configure_testing {
+
+	variable target_idx 0
+
+	proc unique_tgt_name {} {
+		variable target_idx
+		incr target_idx
+		return test_target$target_idx
+	}
+
+	proc target_create_first_args {} {
+		return "target create [unique_tgt_name] testee"
+	}
+
+	proc simple_configure_options {} {
+		return {
+			-work-area-virt 0
+			-work-area-phys 0
+			-work-area-size 1
+			-work-area-backup 0
+			-endian little
+			-coreid 1
+			-chain-position tap.cpu
+			-dbgbase 0
+			-rtos hwthread
+			-gdb-port 0
+			-gdb-max-connections 1
+		}
+	}
+
+	namespace export target_create_first_args simple_configure_options
+}