Hi, in factoring out get-absolute-line, I made a typo in a variable name used in an error message, which causes a tcl ERROR when the error condition is triggered.
Fixed by this patch. This tcl ERROR didn't show up unless the error message was triggered by an error condition, which normally doesn't happen, so I've added a test in gcc.dg-selftests for that. Committed as obvious. Thanks, - Tom [testsuite] Fix get-absolute-line error handling 2018-07-01 Tom de Vries <tdevr...@suse.de> * gcc.dg-selftests/dg-final.exp (verify_call_1): Factor out of ... (verify_call): ... here. Move to toplevel. (verify_call_np, dg_final_directive_check_utils): New proc. (toplevel): Call dg_final_directive_check_utils. * lib/gcc-dg.exp (get-absolute-line): Fix typo in variable reference. --- gcc/testsuite/gcc.dg-selftests/dg-final.exp | 66 ++++++++++++++++++++--------- gcc/testsuite/lib/gcc-dg.exp | 2 +- 2 files changed, 47 insertions(+), 21 deletions(-) diff --git a/gcc/testsuite/gcc.dg-selftests/dg-final.exp b/gcc/testsuite/gcc.dg-selftests/dg-final.exp index 79ffeb3b14f..1d98666e137 100644 --- a/gcc/testsuite/gcc.dg-selftests/dg-final.exp +++ b/gcc/testsuite/gcc.dg-selftests/dg-final.exp @@ -25,29 +25,47 @@ load_lib "scanasm.exp" load_lib "scanwpaipa.exp" load_lib "scanltranstree.exp" load_lib "scanoffloadtree.exp" +load_lib "gcc-dg.exp" -proc dg_final_directive_check_num_args {} { - proc verify_call { args } { - set call_name [lindex $args 0] - set call_args [lindex $args 1] - set expected_error [lindex $args 2] - - set errMsg "" - catch { - eval $call_name $call_args - } errMsg - - if { "$errMsg" != "$call_name: $expected_error" } { - send_log "For call $call_name $call_args\n" - send_log "expected: $call_name: $expected_error\n" - send_log "but got: $errMsg\n" - fail "$call_name: $expected_error" - return - } else { - pass "$call_name: $expected_error" - } +proc verify_call_1 { args } { + set call_name [lindex $args 0] + set call_args [lindex $args 1] + set expected_error [lindex $args 2] + set testid [lindex $args 3] + + set errMsg "" + catch { + eval $call_name $call_args + } errMsg + + if { "$errMsg" != "$expected_error" } { + send_log "For call $call_name $call_args\n" + send_log "expected: $expected_error\n" + send_log "but got: $errMsg\n" + fail "$testid" + return + } else { + pass "$testid" } +} + +proc verify_call { args } { + set call_name [lindex $args 0] + set call_args [lindex $args 1] + set expected_error [lindex $args 2] + verify_call_1 $call_name $call_args "$call_name: $expected_error" \ + "$call_name: $expected_error" +} + +proc verify_call_np { args } { + set call_name [lindex $args 0] + set call_args [lindex $args 1] + set expected_error [lindex $args 2] + verify_call_1 $call_name $call_args "$expected_error" \ + "$call_name: $expected_error" +} +proc dg_final_directive_check_num_args {} { proc verify_args { args } { set proc_name [lindex $args 0] set min [lindex $args 1] @@ -98,9 +116,17 @@ proc dg_final_directive_check_num_args {} { unset testname_with_flags } +proc dg_final_directive_check_utils {} { + verify_call_np get-absolute-line [list "" bla] \ + "dg-line var bla used, but not defined" + verify_call_np get-absolute-line [list 1 bla] \ + "dg-line var bla used at line 1, but not defined" +} + if ![gcc_parallel_test_run_p dg-final] { return } gcc_parallel_test_enable 0 dg_final_directive_check_num_args +dg_final_directive_check_utils gcc_parallel_test_enable 1 diff --git a/gcc/testsuite/lib/gcc-dg.exp b/gcc/testsuite/lib/gcc-dg.exp index 6f88ce2213e..4f1796348c3 100644 --- a/gcc/testsuite/lib/gcc-dg.exp +++ b/gcc/testsuite/lib/gcc-dg.exp @@ -1085,7 +1085,7 @@ proc get-absolute-line { useline line } { eval set var_defined [info exists $varname] if { ! $var_defined } { if { "$useline" != "" } { - error "dg-line var $org_varname used at line $uselinenr, but not defined" + error "dg-line var $org_varname used at line $useline, but not defined" } else { error "dg-line var $org_varname used, but not defined" }