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

[Tom de Vries]

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.

Thanks,
- Tom


Add abort-throw.exp

Todo: Don't create a tclIndex in the source dir.

runtest.log:
...
Running abort-throw.exp ...
PASS: running abort-throw.exp
UNRESOLVED: testcase 'abort-throw.exp' aborted at call to unknown command 'foo'

                ===  Summary ===

\# of expected passes            1
\# of unresolved testcases       1
WARNING: No tool specified
WARNING: Couldn't find tool config file for unix, using default.
ERROR: (DejaGnu) proc "foo" does not exist.
The error code is ARITH DIVZERO {divide by zero}
The info on the error is:
divide by zero
    while executing
"throw {ARITH DIVZERO {divide by zero}} {divide by zero}"
    (procedure "foo" line 2)
    invoked from within
"::tcl_unknown foo"
    ("uplevel" body line 1)
    invoked from within
"uplevel 1 ::tcl_unknown $args"
FAIL: continue after throw
...

---
 testsuite/runtest.main/abort.exp                   |  5 ++++
 .../abort/testsuite/abort.test/abort-throw.exp     | 31 ++++++++++++++++++++++
 .../abort/testsuite/abort.test/lib/foo.tcl         |  3 +++
 3 files changed, 39 insertions(+)

diff --git a/testsuite/runtest.main/abort.exp b/testsuite/runtest.main/abort.exp
index c5f7014..c65d539 100644
--- a/testsuite/runtest.main/abort.exp
+++ b/testsuite/runtest.main/abort.exp
@@ -50,6 +50,11 @@ set tests {
        "PASS: running abort-undef.exp.*\
        *UNRESOLVED: .* aborted at call to unknown command.*\
        *expected passes\[ \t\]+1\n.*unresolved testcases\[ \t\]+1\n" }
+    { "continue after throw"
+       "abort-throw.exp simple.exp"
+       "PASS: running abort-throw.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.*\
diff --git a/testsuite/runtest.main/abort/testsuite/abort.test/abort-throw.exp 
b/testsuite/runtest.main/abort/testsuite/abort.test/abort-throw.exp
new file mode 100644
index 0000000..3e7c1f3
--- /dev/null
+++ b/testsuite/runtest.main/abort/testsuite/abort.test/abort-throw.exp
@@ -0,0 +1,31 @@
+# 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.
+
+# Invoke a divide-by-zero command, in an auto-loaded proc.
+
+pass "running abort-throw.exp"
+
+file delete $srcdir/$subdir/tclIndex
+
+auto_mkindex $srcdir/$subdir lib/*.tcl
+
+lappend auto_path $srcdir/$subdir
+
+foo
+
+fail "script did not abort"
diff --git a/testsuite/runtest.main/abort/testsuite/abort.test/lib/foo.tcl 
b/testsuite/runtest.main/abort/testsuite/abort.test/lib/foo.tcl
new file mode 100644
index 0000000..d623172
--- /dev/null
+++ b/testsuite/runtest.main/abort/testsuite/abort.test/lib/foo.tcl
@@ -0,0 +1,3 @@
+proc foo { } {
+    throw {ARITH DIVZERO {divide by zero}} {divide by zero}
+}