bug#41918: [PATCH] Propagate error value of auto-loaded command

[Jacob Bachmeyer]

Tom de Vries wrote:
> On 6/18/20 1:19 AM, Jacob Bachmeyer wrote:
>   
> > Tom de Vries wrote:
> >     
> > > Hi,
> > >
> > > I think I found a bug in proc unknown in lib/framework.exp.
> > >
> > > Patch describing the problem and fixing it attached below.
> > >   
> > >       
> > I found a similar issue while patching bug #41824; please check whether
> > that patch addresses this issue adequately.
> >     
>
> AFAICT, it does not.  Dejagnu test-case attached.
>   

That test is incorrect:  it does not specify the --keep_going option, 
but expects runtest to continue after a test script aborts with a Tcl error.
I have attached a fixed patch (0004) that avoids modifying the source 
tree by setting up autoloading in the build tree.

I have also attached another patch (0005) that fixes an inconsistency in 
DejaGnu's handling of Tcl errors in test scripts.  Previously, DejaGnu 
would abort the test run if an undefined procedure is called, but would 
only issue an ERROR message and continue with the next test script for 
all other Tcl errors.  This patch solves that by ensuring that DejaGnu 
will abort on any uncaught Tcl error in a test script unless the 
--keep_going option is given on the command line.  An UNRESOLVED result 
appears in the log in any case if a test script aborts due to an error.

Note that --keep_going is *not* expected to be normally used.  The 
--keep_going option "papers over" serious errors in the testsuite, and a 
testsuite that produces Tcl errors is broken, period.  This is the 
reason that there is no supported means for a testsuite to set --keep_going.


-- Jacob

From cbba4dbb8d52c5b0f32e803cf8587f276ee1ec86 Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb62281+dev@gmail.com>
Date: Thu, 18 Jun 2020 17:32:48 -0500
Subject: [PATCH 4/5] Add tests for handling arithmetic errors in auto-loaded 
procedures

---
 ChangeLog                                          |   14 +++++++
 testsuite/runtest.main/abort.exp                   |   11 ++++++
 .../abort/testsuite/abort.test/abort-al-dbz.exp    |   38 ++++++++++++++++++++
 3 files changed, 63 insertions(+), 0 deletions(-)
 create mode 100644 
testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp

diff --git a/ChangeLog b/ChangeLog
index 17bb158..f60a023 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2020-06-18  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
+
+       PR 41824 / PR 41918
+
+       Thanks to Tom de Vries for raising these concerns and offering the
+       initial patch that was rewritten to produce this.
+
+       * testsuite/runtest.main/abort.exp: Add tests to verify handling
+       of arithmetic errors (divide-by-zero) in an auto-loaded procedure
+       called from a test script.
+
+       * testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp:
+       New file.
+
 2020-06-17  Jacob Bachmeyer  <jcb62281+dev@gmail.com>
 
        PR 41824
diff --git a/testsuite/runtest.main/abort.exp b/testsuite/runtest.main/abort.exp
index c5f7014..864f1e0 100644
--- a/testsuite/runtest.main/abort.exp
+++ b/testsuite/runtest.main/abort.exp
@@ -50,6 +50,16 @@ set tests {
        "PASS: running abort-undef.exp.*\
        *UNRESOLVED: .* aborted at call to unknown command.*\
        *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
+    { "stop at auto-loaded divide-by-zero without --keep_going"
+       "abort-al-dbz.exp simple.exp"
+       "PASS: running abort-al-dbz.exp.*\
+       *UNRESOLVED: .* aborted at .*\
+       *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
+    { "continue after auto-loaded divide-by-zero with --keep_going"
+       "--keep_going abort-al-dbz.exp simple.exp"
+       "PASS: running abort-al-dbz.exp.*\
+       *PASS: simple test.*\
+       *expected passes\[ \t\]+2\n" }
     { "stop at abort without --keep_going"
        "abort-undef.exp simple.exp"
        "PASS: running abort-undef.exp.*\
@@ -76,3 +86,4 @@ foreach t $tests {
 }
 
 file delete -force $tmpdir
+file delete -force [testsuite file -object -test abort testsuite abort.test 
lib]
diff --git a/testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp 
b/testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp
new file mode 100644
index 0000000..df55a9a
--- /dev/null
+++ b/testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp
@@ -0,0 +1,38 @@
+# Copyright (C) 2020 Free Software Foundation, Inc.
+#
+# This file is part of DejaGnu.
+#
+# DejaGnu is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# DejaGnu is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with DejaGnu; if not, write to the Free Software Foundation,
+# Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
+
+# Cause a divide-by-zero error in an auto-loaded procedure.
+
+pass "running abort-al-dbz.exp"
+
+set fd [open [testsuite file -object -test lib foo.tcl] w]
+puts $fd {proc throw_arith_error_div_by_zero { } {
+    expr { 1 / 0 }
+}
+}
+close $fd
+
+auto_mkindex \
+    [testsuite file -object -test lib] \
+    [testsuite file -object -test lib/*.tcl]
+
+lappend auto_path [testsuite file -object -test lib]
+
+throw_arith_error_div_by_zero
+
+fail "script did not abort"
-- 
1.7.4.1

From d45310cd257d399b8208fa9907f7c9f2f4ac7eda Mon Sep 17 00:00:00 2001
From: Jacob Bachmeyer <jcb62281+dev@gmail.com>
Date: Thu, 18 Jun 2020 18:52:33 -0500
Subject: [PATCH 5/5] Use consistent behavior for Tcl errors in test scripts

---
 ChangeLog                        |   15 ++++++++++-
 NEWS                             |    3 ++
 lib/framework.exp                |   46 +++++++++++++++++++++----------------
 runtest.exp                      |    6 +++++
 testsuite/runtest.main/abort.exp |    9 ++++---
 5 files changed, 53 insertions(+), 26 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index f60a023..e9f1664 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -3,11 +3,22 @@
        PR 41824 / PR 41918
 
        Thanks to Tom de Vries for raising these concerns and offering the
-       initial patch that was rewritten to produce this.
+       initial testsuite patch that led to these changes.
+
+       * NEWS: Add item for consistent abort-on-error handling.
+
+       * lib/framework.exp (unknown): Always link global variables.  Tidy.
+       Silently propagate errors raised in autoloaded procedures and move
+       the UNRESOLVED result and aborting the test run to...
+       * runtest.exp (runtest): Report an UNRESOLVED result if a test
+       script aborts due to a Tcl error.  Link global errorCode and
+       report its value if an error occurs.  For consistency, abort the
+       test run on any Tcl error in a test script instead of only when
+       calling an undefined procedure.
 
        * testsuite/runtest.main/abort.exp: Add tests to verify handling
        of arithmetic errors (divide-by-zero) in an auto-loaded procedure
-       called from a test script.
+       called from a test script.  Adjust other patterns.
 
        * testsuite/runtest.main/abort/testsuite/abort.test/abort-al-dbz.exp:
        New file.
diff --git a/NEWS b/NEWS
index 4354422..619f0ff 100644
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ Changes since 1.6.2:
    the default of reading "site.exp".  See the manual for details.
 X. runtest now accepts a --keep_going option to continue with other test
    scripts after a test script invokes an undefined command.
+X. Unless the --keep_going option is used, runtest now aborts if a test
+   script fails with any Tcl error.  Previously, only calling an undefined
+   procedure would cause the test run to abort.
 3. A utility procedure relative_filename has been added.  This procedure
    computes a relative file name to a given destination from a given base.
 4. The utility procedure 'grep' now accepts a '-n' option that
diff --git a/lib/framework.exp b/lib/framework.exp
index db6e661..0850595 100644
--- a/lib/framework.exp
+++ b/lib/framework.exp
@@ -258,36 +258,42 @@ proc isnative { } {
 
 rename ::unknown ::tcl_unknown
 proc unknown { args } {
+    global errorCode
+    global errorInfo
+    global exit_status
+
     set code [catch {uplevel 1 ::tcl_unknown $args} msg]
     if { $code != 0 } {
-       global errorCode
-       global errorInfo
-       global exit_status
-
        set ret_cmd [list return -code $code]
 
-       clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist."
-       if {[info exists errorCode]} {
+       # If the command now exists, then it was autoloaded.  We are here,
+       # therefore invoking the autoloaded command raised an error.
+       # Silently propagate errors from autoloaded procedures, but
+       # complain noisily about undefined commands.
+       set have_it_now [llength [info commands [lindex $args 0]]]
+
+       if { ! $have_it_now } {
+           clone_output "ERROR: (DejaGnu) proc \"$args\" does not exist."
+           set exit_status 2
+       }
+
+       if { [info exists errorCode] } {
            lappend ret_cmd -errorcode $errorCode
-           send_error "The error code is $errorCode\n"
+           if { ! $have_it_now } {
+               send_error "The error code is $errorCode\n"
+           }
        }
-       if {[info exists errorInfo]} {
-           # omitting errorInfo from the propagated error makes this code
+       if { [info exists errorInfo] } {
+           # omitting errorInfo from the propagated error makes this proc
            # invisible with the backtrace pointing directly to the problem
-           send_error "The info on the error is:\n$errorInfo\n"
+           if { ! $have_it_now } {
+               send_error "The info on the error is:\n$errorInfo\n"
+           }
        }
-       set exit_status 2
-
-       set unresolved_msg "testcase '[uplevel info script]' aborted"
-       append unresolved_msg " at call to unknown command '$args'"
-       unresolved $unresolved_msg
 
        lappend ret_cmd $msg
-       if { $::dejagnu::opt::keep_going } {
-           eval $ret_cmd
-       } else {
-           log_and_exit
-       }
+
+       eval $ret_cmd
     } else {
        # Propagate return value.
        return $msg
diff --git a/runtest.exp b/runtest.exp
index 028ad5b..245c536 100644
--- a/runtest.exp
+++ b/runtest.exp
@@ -1562,6 +1562,7 @@ proc runtest { test_file_name } {
     global bug_id
     global test_result
     global errcnt
+    global errorCode
     global errorInfo
     global tool
     global testdir
@@ -1596,10 +1597,15 @@ proc runtest { test_file_name } {
            # increments `errcnt'.  If we do call perror we'd have to
            # reset errcnt afterwards.
            clone_output "ERROR: tcl error sourcing $test_file_name."
+           if {[info exists errorCode]} {
+               clone_output "ERROR: tcl error code $errorCode"
+           }
            if {[info exists errorInfo]} {
                clone_output "ERROR: $errorInfo"
                unset errorInfo
            }
+           unresolved "testcase '$test_file_name' aborted due to Tcl error"
+           if { ! $::dejagnu::opt::keep_going } { log_and_exit }
        }
 
        if {[info exists tool]} {
diff --git a/testsuite/runtest.main/abort.exp b/testsuite/runtest.main/abort.exp
index 864f1e0..b352b56 100644
--- a/testsuite/runtest.main/abort.exp
+++ b/testsuite/runtest.main/abort.exp
@@ -48,27 +48,28 @@ set tests {
     { "abort on undefined command"
        "abort-undef.exp"
        "PASS: running abort-undef.exp.*\
-       *UNRESOLVED: .* aborted at call to unknown command.*\
+       *UNRESOLVED: .* aborted.*\
        *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
     { "stop at auto-loaded divide-by-zero without --keep_going"
        "abort-al-dbz.exp simple.exp"
        "PASS: running abort-al-dbz.exp.*\
-       *UNRESOLVED: .* aborted at .*\
+       *UNRESOLVED: .* aborted.*\
        *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
     { "continue after auto-loaded divide-by-zero with --keep_going"
        "--keep_going abort-al-dbz.exp simple.exp"
        "PASS: running abort-al-dbz.exp.*\
+       *UNRESOLVED: .* aborted.*\
        *PASS: simple test.*\
        *expected passes\[ \t\]+2\n" }
     { "stop at abort without --keep_going"
        "abort-undef.exp simple.exp"
        "PASS: running abort-undef.exp.*\
-       *UNRESOLVED: .* aborted at call to unknown command.*\
+       *UNRESOLVED: .* aborted.*\
        *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
     { "continue after abort with --keep_going"
        "--keep_going abort-undef.exp simple.exp"
        "PASS: running abort-undef.exp.*\
-       *UNRESOLVED: .* aborted at call to unknown command.*\
+       *UNRESOLVED: .* aborted.*\
        *PASS: simple test.*\
        *expected passes\[ \t\]+2\n.*unresolved testcases\[ \t\]+1\n" }
 }
-- 
1.7.4.1