Possible bug in Tcl.pm exposed by Tktable?

[Christopher Chavez]

Here's an issue I've known about for several months but hadn't reported.
I'm curious if there are any ideas here for debugging or what the cause
might be (if obviously in Tcl.pm), or if I should go ahead and report it
to Debian package maintainers.

Christopher A. Chavez

-------------------------------------------------------------------------

Using Debian 10 buster amd64, and packages provided by Debian:

perl 5.28.1-6
tk 8.6.9-2
tk-table 2.10-4 (borrowed from testing/bullseye; I can't find debug
symbols for 2.10-3)

plus Tcl.pm 1.27 (either Debian's libtcl-perl 1.27+ds-1, or from GitHub
master branch).

(I'm not sure which package might be responsible for this issue.
I believe I also observed this issue on a recent version of Ubuntu.)

Any normal usage of Tktable from Perl (e.g. with a wrapper like Tkx,
Tcl::Tk, or Tcl::pTk) will seem to work fine, but an error occurs when
the program is closed:

munmap_chunk(): invalid pointer
Aborted (core dumped)

This error does not occur when using Tktable directly from Tcl/Tk
(e.g. tclsh/wish), so I suspect the issue may be in Tcl.pm or Perl.

Example Perl script that exhibits the error:

use Tcl;
my $i = new Tcl;
$i->Init;
$i->Eval('package require Tk');
$i->Eval('package require Tktable');
$i->Eval('destroy .');

Valgrind indicates the error is due to an invalid free, but the exact
code responsible for the issue is unclear to me:

$ valgrind --num-callers=100 perl tktable-test.pl
==17734== Memcheck, a memory error detector
==17734== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==17734== Using Valgrind-3.14.0 and LibVEX; rerun with -h for copyright info
==17734== Command: perl -Mblib tktable-test.pl
...
[omitting "Invalid read of size 1" error -- known behavior when Tk
is loaded, https://core.tcl-lang.org/tk/tktview?name=e42eef33ee ]
...
==17734== Invalid free() / delete / delete[] / realloc()
==17734== at 0x48369AB: free (vg_replace_malloc.c:530)
==17734== by 0x162304: perl_destruct (in /usr/bin/perl)
==17734== by 0x13C3DB: main (in /usr/bin/perl)
==17734== Address 0x52012a0 is 8,400 bytes inside a block of size
16,384 alloc'd
==17734== at 0x483577F: malloc (vg_replace_malloc.c:299)
==17734== by 0x5550DFE: GetBlocks (tclThreadAlloc.c:1044)
==17734== by 0x5550549: TclpAlloc (tclThreadAlloc.c:358)
==17734== by 0x5459272: newstate (regc_nfa.c:135)
==17734== by 0x54548B8: parseqatom (regcomp.c:1136)
==17734== by 0x5453FA3: parsebranch (regcomp.c:760)
==17734== by 0x5453DF2: parse (regcomp.c:689)
==17734== by 0x545365E: TclReComp (regcomp.c:382)
==17734== by 0x5542841: CompileRegexp (tclRegexp.c:934)
==17734== by 0x5542404: Tcl_GetRegExpFromObj (tclRegexp.c:593)
==17734== by 0x547FCF4: Tcl_RegexpObjCmd (tclCmdMZ.c:268)
==17734== by 0x5467FB6: TclNRRunCallbacks (tclBasic.c:4461)
==17734== by 0x54693AE: TclEvalEx (tclBasic.c:5330)
==17734== by 0x5468D12: Tcl_EvalEx (tclBasic.c:4995)
==17734== by 0x54078CB: XS_Tcl_Eval (Tcl.xs:1097)
==17734== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==17734== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==17734== by 0x166116: perl_run (in /usr/bin/perl)
==17734== by 0x13C401: main (in /usr/bin/perl)
==17734==
==17734== Invalid free() / delete / delete[] / realloc()
==17734== at 0x48369AB: free (vg_replace_malloc.c:530)
==17734== by 0x162322: perl_destruct (in /usr/bin/perl)
==17734== by 0x13C3DB: main (in /usr/bin/perl)
==17734== Address 0x536add0 is 8,720 bytes inside a block of size
16,384 alloc'd
==17734== at 0x483577F: malloc (vg_replace_malloc.c:299)
==17734== by 0x5550DFE: GetBlocks (tclThreadAlloc.c:1044)
==17734== by 0x5550549: TclpAlloc (tclThreadAlloc.c:358)
==17734== by 0x5471A87: Tcl_Alloc (tclCkalloc.c:1059)
==17734== by 0x5512900: AllocChannelBuffer (tclIO.c:2453)
==17734== by 0x5512900: GetInput (tclIO.c:6843)
==17734== by 0x5511B5C: DoReadChars (tclIO.c:5867)
==17734== by 0x5522605: TclNREvalFile (tclIOUtil.c:1920)
==17734== by 0x5480DE5: TclNRSourceObjCmd (tclCmdMZ.c:1013)
==17734== by 0x5467FB6: TclNRRunCallbacks (tclBasic.c:4461)
==17734== by 0x54693AE: TclEvalEx (tclBasic.c:5330)
==17734== by 0x5468D12: Tcl_EvalEx (tclBasic.c:4995)
==17734== by 0x54078CB: XS_Tcl_Eval (Tcl.xs:1097)
==17734== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==17734== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==17734== by 0x166116: perl_run (in /usr/bin/perl)
==17734== by 0x13C401: main (in /usr/bin/perl)

[Christopher Chavez]

On 3/7/2020 10:01 PM, Christopher Chavez wrote:
> ==17734==  Address 0x52012a0 is 8,400 bytes inside a block of size
> 16,384 alloc'd
> ==17734==    at 0x483577F: malloc (vg_replace_malloc.c:299)
> ==17734==    by 0x5550DFE: GetBlocks (tclThreadAlloc.c:1044)
> ==17734==    by 0x5550549: TclpAlloc (tclThreadAlloc.c:358)
…

> ==17734==  Address 0x536add0 is 8,720 bytes inside a block of size

> 16,384 alloc'd
> ==17734==    at 0x483577F: malloc (vg_replace_malloc.c:299)
> ==17734==    by 0x5550DFE: GetBlocks (tclThreadAlloc.c:1044)
> ==17734==    by 0x5550549: TclpAlloc (tclThreadAlloc.c:358)
> ==17734==    by 0x5471A87: Tcl_Alloc (tclCkalloc.c:1059)

The addresses involved are inside allocations from Tcl's thread block
cache, which I'm guessing could be heavily reused over the life of a Tcl
program (to minimize direct calls to malloc()). I'll ask Tcl developers,
but is anyone here aware of a way to disable this or make it
debugging-friendly to identify what the last user of the block is?

[Christopher Chavez]

On 3/16/2020 3:48 AM, Christopher Chavez wrote:
> The addresses involved are inside allocations from Tcl's thread block
> cache, which I'm guessing could be heavily reused over the life of a Tcl
> program (to minimize direct calls to malloc()). I'll ask Tcl developers,
> but is anyone here aware of a way to disable this or make it
> debugging-friendly to identify what the last user of the block is?

To partially answer my own question:
there are some compile-time techniques to try like -DPURIFY
https://wiki.tcl-lang.org/page/How+to+debug+memory+faults+in+Tcl+and+extensions

That page mentioned the Tcl exit command, which I've never used
from Perl. Adding it completely prevents the error:

use Tcl;
my $i = new Tcl;
$i->Init;

$i->Eval(<<'EOS');

package require Tk
package require Tktable
destroy .
exit

EOS


But should things like destroying the root window and Tcl exit really
be necessary to prevent errors during normal usage?

Christopher A. Chavez

[Christopher Chavez]

On 3/16/2020 4:09 AM, Christopher Chavez wrote:
> That page mentioned the Tcl exit command, which I've never used
> from Perl. Adding it completely prevents the error:
>
>
>     use Tcl;
>     my $i = new Tcl;
>     $i->Init;
>     $i->Eval(<<'EOS');
>
>     package require Tk
>     package require Tktable
>     destroy .
>     exit
>
>     EOS
>
>
> But should things like destroying the root window and Tcl exit really
> be necessary to prevent errors during normal usage?

Actually, doing $i->Eval('exit') makes the entire program exit
immediately without letting Perl continue execution or perform
its own exit, so maybe it's not a good idea to use it.

Christopher A. Chavez

[Christopher Chavez]

On 3/16/2020 4:09 AM, Christopher Chavez wrote:

> To partially answer my own question:
> there are some compile-time techniques to try like -DPURIFY
> https://wiki.tcl-lang.org/page/How+to+debug+memory+faults+in+Tcl+and+extensions

After build from upstream sources (Tcl/Tk core-8-6-branch and
TkTable 2.11 -- no Debian/Ubuntu Tcl/Tk packages) with -DPURIFY,
the error is revealed to be a double free. The addresses involved
correspond to strings allocated for environment variable(s)
set by Tktable (tkTableInitScript.h).

A simpler program without Tk or Tktable reveals the same issue:

use Tcl;

my $i = new Tcl;
$i->Init;

$i->Eval('set env(FOO) bar');


Command line output:

free(): double free detected in tcache 2
Aborted (core dumped)

Valgrind output:

==13666== Invalid free() / delete / delete[] / realloc()
==13666== at 0x48369AB: free (vg_replace_malloc.c:530)
==13666== by 0x162304: perl_destruct (in /usr/bin/perl)
==13666== by 0x13C3DB: main (in /usr/bin/perl)
==13666== Address 0x5229a20 is 0 bytes inside a block of size 8 free'd
==13666== at 0x48369AB: free (vg_replace_malloc.c:530)
==13666== by 0x543EE86: TclpFree (tclAlloc.c:722)
==13666== by 0x5517935: TclFinalizeEnvironment (tclEnv.c:768)
==13666== by 0x5519268: Tcl_Finalize (tclEvent.c:1151)
==13666== by 0x485123D: XS_Tcl__Finalize (Tcl.xs:1449)
==13666== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==13666== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==13666== by 0x15DF61: Perl_call_sv (in /usr/bin/perl)
==13666== by 0x160AC3: Perl_call_list (in /usr/bin/perl)
==13666== by 0x16235E: perl_destruct (in /usr/bin/perl)
==13666== by 0x13C3DB: main (in /usr/bin/perl)
==13666== Block was alloc'd at
==13666== at 0x4837D7B: realloc (vg_replace_malloc.c:826)
==13666== by 0x543EEAA: TclpRealloc (tclAlloc.c:747)
==13666== by 0x5456E8D: Tcl_Realloc (tclCkalloc.c:1147)
==13666== by 0x55172A9: TclSetEnv (tclEnv.c:317)
==13666== by 0x5517688: EnvTraceProc (tclEnv.c:636)
==13666== by 0x55A0B69: TclCallVarTraces (tclTrace.c:2678)
==13666== by 0x55A0860: TclObjCallVarTraces (tclTrace.c:2564)
==13666== by 0x55AAFDB: TclPtrSetVarIdx (tclVar.c:2001)
==13666== by 0x55AA957: Tcl_ObjSetVar2 (tclVar.c:1770)
==13666== by 0x55AA609: Tcl_SetObjCmd (tclVar.c:1529)
==13666== by 0x544A42A: Dispatch (tclBasic.c:4456)
==13666== by 0x544A4B0: TclNRRunCallbacks (tclBasic.c:4492)
==13666== by 0x5449D83: Tcl_EvalObjv (tclBasic.c:4215)
==13666== by 0x544C1AB: TclEvalEx (tclBasic.c:5361)
==13666== by 0x544B571: Tcl_EvalEx (tclBasic.c:5026)
==13666== by 0x48525A8: XS_Tcl_Eval (Tcl.xs:1097)
==13666== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==13666== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==13666== by 0x166116: perl_run (in /usr/bin/perl)
==13666== by 0x13C401: main (in /usr/bin/perl)
==13666==
==13666== Invalid free() / delete / delete[] / realloc()
==13666== at 0x48369AB: free (vg_replace_malloc.c:530)
==13666== by 0x162322: perl_destruct (in /usr/bin/perl)
==13666== by 0x13C3DB: main (in /usr/bin/perl)
==13666== Address 0x5229810 is 0 bytes inside a block of size 376 free'd
==13666== at 0x48369AB: free (vg_replace_malloc.c:530)
==13666== by 0x543EE86: TclpFree (tclAlloc.c:722)
==13666== by 0x5517983: TclFinalizeEnvironment (tclEnv.c:776)
==13666== by 0x5519268: Tcl_Finalize (tclEvent.c:1151)
==13666== by 0x485123D: XS_Tcl__Finalize (Tcl.xs:1449)
==13666== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==13666== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==13666== by 0x15DF61: Perl_call_sv (in /usr/bin/perl)
==13666== by 0x160AC3: Perl_call_list (in /usr/bin/perl)
==13666== by 0x16235E: perl_destruct (in /usr/bin/perl)
==13666== by 0x13C3DB: main (in /usr/bin/perl)
==13666== Block was alloc'd at
==13666== at 0x483577F: malloc (vg_replace_malloc.c:299)
==13666== by 0x543EE6C: TclpAlloc (tclAlloc.c:699)
==13666== by 0x5456D99: Tcl_Alloc (tclCkalloc.c:1059)
==13666== by 0x5517074: TclSetEnv (tclEnv.c:263)
==13666== by 0x5517688: EnvTraceProc (tclEnv.c:636)
==13666== by 0x55A0B69: TclCallVarTraces (tclTrace.c:2678)
==13666== by 0x55A0860: TclObjCallVarTraces (tclTrace.c:2564)
==13666== by 0x55AAFDB: TclPtrSetVarIdx (tclVar.c:2001)
==13666== by 0x55AA957: Tcl_ObjSetVar2 (tclVar.c:1770)
==13666== by 0x55AA609: Tcl_SetObjCmd (tclVar.c:1529)
==13666== by 0x544A42A: Dispatch (tclBasic.c:4456)
==13666== by 0x544A4B0: TclNRRunCallbacks (tclBasic.c:4492)
==13666== by 0x5449D83: Tcl_EvalObjv (tclBasic.c:4215)
==13666== by 0x544C1AB: TclEvalEx (tclBasic.c:5361)
==13666== by 0x544B571: Tcl_EvalEx (tclBasic.c:5026)
==13666== by 0x48525A8: XS_Tcl_Eval (Tcl.xs:1097)
==13666== by 0x1F4360: Perl_pp_entersub (in /usr/bin/perl)
==13666== by 0x1EA685: Perl_runops_standard (in /usr/bin/perl)
==13666== by 0x166116: perl_run (in /usr/bin/perl)
==13666== by 0x13C401: main (in /usr/bin/perl)



(Note that I built Tcl/Tk with threads, since that is how Debian/Ubuntu
Tcl/Tk are built; not yet sure if that affects this issue. Using system
Perl vs self-compiled Perl should not be a factor, since Travis CI uses
Perlbrew whereas I've used the system Perl.)


Christopher A. Chavez