forked from auracaster/openocd
d2aeb5fcc9
Commit 93f16eed4d ("command: fix OpenOCD commands return value
for next jimtcl") aligns the return of OpenOCD Tcl commands to the
standard Tcl error codes.
This has the side effect to hide the internal OpenOCD error codes
(e.g. ERROR_FAIL = -4) from the Tcl environment. These codes are
for internal use, can change during OpenOCD development and should
not be exposed to the user.
Nevertheless, some ACI test has been instrumented to check such
values and there is a requirement to make them available, possibly
without breaking the Tcl language rules.
Tcl allows procedures to return, through the 'return' command [1]:
- the result text;
- a return code like 'ok' or 'error';
- an optional 'errorcode';
- ...
The optional 'errorcode' can be exploited to propagate the OpenOCD
error code to the Tcl script for ACI test purpose.
It would be equivalent of considering the OpenOCD commands as Tcl
procedures that either returns as:
return -code ok 'command output text'
or return an error as:
return -code error -errorcode {OpenOCD -4} 'error text'
where '-4' is the OpenOCD value for ERROR_FAIL.
Tcl stores the errorcode in the global variable 'errorCode' that
can be easily accessed within a Tcl script [2].
The variable 'errorCode' is by default set to 'NONE' and has to be
set to a Tcl list. The first element of the list identifies the
general class of errors and determines the format of the rest of
the list. This allows the required flexibility to propagate the
OpenOCD error codes in a format unique that does not impact other
Tcl functionality.
Propagates the OpenOCD error code in the Tcl global variable
'errorCode' as a Tcl list formatted as {OpenOCD %s}.
Modify the test script to check for OpenOCD error code.
Link: https://www.tcl-lang.org/man/tcl8.6/TclCmd/return.htm [1]
Link: https://www.tcl-lang.org/man/tcl8.6/TclCmd/tclvars.htm [2]
Change-Id: Ia5007e04b3c061a0f7a74387b51ab2a57c658088
Signed-off-by: Antonio Borneo <borneo.antonio@gmail.com>
Reviewed-on: https://review.openocd.org/c/openocd/+/9186
Reviewed-by: zapb <dev@zapb.de>
Tested-by: jenkins
Reviewed-by: Evgeniy Naydanov <eugnay@gmail.com>
86 lines
2.0 KiB
Tcl
86 lines
2.0 KiB
Tcl
# 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 ::errorCode NONE
|
|
set code [catch {uplevel $script} msg]
|
|
set expanded_script [uplevel subst \"$script\"]
|
|
if {$code == 0} {
|
|
test_failure \
|
|
"'$expanded_script' finished successfully. \
|
|
Was expecting an error."
|
|
}
|
|
if {$code != 1} {
|
|
test_failure \
|
|
"'$expanded_script' returned unexpected error code $code"
|
|
}
|
|
if {$expctd_code ne "" && ([lindex $::errorCode 0] ne "OpenOCD" || [lindex $::errorCode 1] != $expctd_code)} {
|
|
test_failure \
|
|
"'$expanded_script' returned unexpected error code '$::errorCode'. \
|
|
Was expecting 'OpenOCD $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
|
|
}
|