This is an automated email from Gerrit. "Antonio Borneo <[email protected]>" just uploaded a new patch set to Gerrit, which you can find at https://review.openocd.org/c/openocd/+/9186
-- gerrit commit 6b5630abb080dff04c4ec4e425eb3e648852b62a Author: Antonio Borneo <[email protected]> Date: Fri Oct 24 10:12:30 2025 +0200 command: return OpenOCD error code as Tcl 'errorCode' Commit 93f16eed4d4d ("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 <[email protected]> diff --git a/src/helper/command.c b/src/helper/command.c index d2a0314782..867a840134 100644 --- a/src/helper/command.c +++ b/src/helper/command.c @@ -474,6 +474,11 @@ static int jim_exec_command(Jim_Interp *interp, struct command_context *context, if (retval == ERROR_COMMAND_CLOSE_CONNECTION) return JIM_EXIT; + Jim_Obj *error_code = Jim_NewListObj(context->interp, NULL, 0); + Jim_ListAppendElement(context->interp, error_code, Jim_NewStringObj(context->interp, "OpenOCD", -1)); + Jim_ListAppendElement(context->interp, error_code, Jim_NewIntObj(context->interp, retval)); + Jim_SetGlobalVariableStr(context->interp, "errorCode", error_code); + return JIM_ERR; } diff --git a/testing/tcl_commands/utils.tcl b/testing/tcl_commands/utils.tcl index 65e52d2fe0..087bf04378 100644 --- a/testing/tcl_commands/utils.tcl +++ b/testing/tcl_commands/utils.tcl @@ -8,17 +8,22 @@ namespace eval testing_helpers { } 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} { + if {$code == 0} { test_failure \ "'$expanded_script' finished successfully. \ Was expecting an error." } - if {$expctd_code ne "" && $code != $expctd_code} { + if {$code != 1} { test_failure \ - "'$expanded_script' returned unexpected error code $code. \ - Was expecting $expctd_code. Error message: '$msg'" + "'$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 \ @@ -32,7 +37,7 @@ namespace eval testing_helpers { } proc check_syntax_err script { - tailcall check_for_error 1 {} $script + tailcall check_for_error -601 {} $script } proc check_matches {pattern script} { diff --git a/tools/scripts/camelcase.txt b/tools/scripts/camelcase.txt index 1c782ee351..95ef4af551 100644 --- a/tools/scripts/camelcase.txt +++ b/tools/scripts/camelcase.txt @@ -113,17 +113,20 @@ Jim_GetWide Jim_IncrRefCount Jim_InitStaticExtensions Jim_Interp +Jim_ListAppendElement Jim_ListGetIndex Jim_ListLength Jim_MakeErrorMessage Jim_NewEmptyStringObj Jim_NewIntObj +Jim_NewListObj Jim_NewStringObj Jim_Obj Jim_ProcessEvents Jim_RegisterCoreCommands Jim_SetAssocData Jim_SetEmptyResult +Jim_SetGlobalVariableStr Jim_SetResult Jim_SetResultFormatted Jim_SetResultString --
