Archive::Tar and Tk don't play nice together

From a big application, I reduced it to this test case.
Maybe it can be
even shorter, but this should do ...


--8<--- test.pl
#!/pro/bin/perl

use strict;
use warnings;

use Tk;
use Cwd;
use Archive::Tar;

my $mw = MainWindow->new;
$mw->Label (-text => "Test");

if ($mw) {
    my $tar = 0;
    my $tl  = $mw->Toplevel;
    $tl->Checkbutton (-text => "Create",
-variable => $tar)->pack;
    $tl->Button (-text => "Exit", -command
=> sub { exit; })->pack;
    $tl->Button (-text => "GO", -command
=> sub {
	my $pwd = getcwd;
	$tar and $tar = Archive::Tar->new;
	foreach my $f ("/etc/motd",
"/etc/hosts") {
	    my ($dir, $file) = ($f =~ m{^(.*)/(.*)$});
	    chdir $dir or die "Cannot chdir to $dir:
$!n";
	    $tar and $tar->add_files ($file);
	    }
	$tar and $tar->write ("/tmp/test.tgz", 9);
	chdir $pwd;
	$tl->destroy;
	})->pack;
    }

MainLoop;
-->8---

All goes well untill you check the checkbutton, click on GO
and then
leave the applic. You get a segmentation fault, but the
test.tgz is
created correct.

No core dump is created, and I do have the write rights.

(gdb) run test.pl
Starting program: /pro/bin/perl test.pl
[Thread debugging using libthread_db enabled]
[New Thread 47147403370544 (LWP 28717)]
Error while reading shared library symbols:
Cannot find new threads: generic error

Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 47147403370544 (LWP 28717)]
0x00002ae15c0de220 in strcmp () from /lib64/libc.so.6
(gdb)

-- 
H.Merijn Brand         Amsterdam Perl Mongers (http://amsterdam.pm.org/
)
using & porting perl 5.6.2, 5.8.x, 5.10.x  on HP-UX
10.20, 11.00, 11.11,
& 11.23, SuSE 10.1 & 10.2, AIX 5.2, and Cygwin.     
 http://qa.perl.org
http://mirrors.de
velooper.com/hpux/            http://www.test-smoke.org
                        http
://www.goldmark.org/jeff/stupid-disclaimers/

On Tue, 23 Oct 2007 16:03:52 +0000, "H.Merijn
Brand" <h.m.brandxs4all.nl>
wrote:

> From a big application, I reduced it to this test case.
Maybe it can be
> even shorter, but this should do ...
> 
> 
> --8<--- test.pl
> #!/pro/bin/perl
> 
> use strict;
> use warnings;
> 
> use Tk;
> use Cwd;
> use Archive::Tar;
> 
> my $mw = MainWindow->new;
> $mw->Label (-text => "Test");
> 
> if ($mw) {
>     my $tar = 0;
>     my $tl  = $mw->Toplevel;
>     $tl->Checkbutton (-text =>
"Create", -variable => $tar)->pack;
>     $tl->Button (-text => "Exit",
-command => sub { exit; })->pack;
>     $tl->Button (-text => "GO",
-command => sub {
> 	my $pwd = getcwd;
> 	$tar and $tar = Archive::Tar->new;
> 	foreach my $f ("/etc/motd",
"/etc/hosts") {
> 	    my ($dir, $file) = ($f =~ m{^(.*)/(.*)$});
> 	    chdir $dir or die "Cannot chdir to $dir:
$!n";
> 	    $tar and $tar->add_files ($file);
> 	    }
> 	$tar and $tar->write ("/tmp/test.tgz",
9);
> 	chdir $pwd;
> 	$tl->destroy;
> 	})->pack;
>     }
> 
> MainLoop;
> -->8---
> 
> All goes well untill you check the checkbutton, click
on GO and then
> leave the applic. You get a segmentation fault, but the
test.tgz is
> created correct.
> 
> No core dump is created, and I do have the write
rights.
> 
> (gdb) run test.pl
> Starting program: /pro/bin/perl test.pl
> [Thread debugging using libthread_db enabled]
> [New Thread 47147403370544 (LWP 28717)]
> Error while reading shared library symbols:
> Cannot find new threads: generic error
> 
> Program received signal SIGSEGV, Segmentation fault.
> [Switching to Thread 47147403370544 (LWP 28717)]
> 0x00002ae15c0de220 in strcmp () from /lib64/libc.so.6
> (gdb)

(gdb) where
#0  0x00002affddd64220 in strcmp () from /lib64/libc.so.6
#1  0x00002affde6b5af9 in ButtonVarProc ()
   from
/pro/lib/perl5/site_perl/5.8.8/x86_64-linux/auto/Tk/Tk.so
#2  0x00002affde695d1b in TraceExitHandler ()
   from
/pro/lib/perl5/site_perl/5.8.8/x86_64-linux/auto/Tk/Tk.so
#3  0x00002affde0410b8 in Tcl_Finalize ()
   from
/pro/lib/perl5/site_perl/5.8.8/x86_64-linux/auto/Tk/Event/Ev
ent.so
#4  0x00002affde03e195 in XS_Tk_END ()
   from
/pro/lib/perl5/site_perl/5.8.8/x86_64-linux/auto/Tk/Event/Ev
ent.so
#5  0x000000000044ac77 in Perl_pp_entersub ()
#6  0x0000000000444068 in S_call_body ()
#7  0x0000000000444c45 in Perl_call_sv ()
#8  0x0000000000444fa9 in Perl_call_list ()
#9  0x00000000004491a6 in perl_destruct ()
#10 0x000000000041c3d7 in main ()
(gdb)


-- 
H.Merijn Brand         Amsterdam Perl Mongers (http://amsterdam.pm.org/
)
using & porting perl 5.6.2, 5.8.x, 5.10.x  on HP-UX
10.20, 11.00, 11.11,
& 11.23, SuSE 10.1 & 10.2, AIX 5.2, and Cygwin.     
 http://qa.perl.org
http://mirrors.de
velooper.com/hpux/            http://www.test-smoke.org
                        http
://www.goldmark.org/jeff/stupid-disclaimers/

"H.Merijn Brand" <h.m.brandxs4all.nl> writes:

> >From a big application, I reduced it to this test
case. Maybe it can be
> even shorter, but this should do ...
> 

I can reduce it to:

#!perl
use Tk;
$top = new MainWindow;
$top->Checkbutton (-variable => $tar)->pack;
$top->Button(-command => sub {
		 $tar = bless {}, "foo";
		 $top->destroy;
	     })->pack;
MainLoop;
__END__

The error occurs in the line

    if (strcmp(value, Tcl_GetString(butPtr->onValuePtr))
== 0) {

and butPtr->onValuePtr is 0 here. I guess that some kind
of
destruction cleanup occured here before Tk tried to access
the
checkbutton value a last time.

I suggest to not use the same variable as checkbutton flag
and blessed
object.

Regards,
        Slaven

-- 
Slaven Rezic - slaven <at> rezic <dot> de

    tkruler - Perl/Tk program for measuring screen
distances
    http://ptkto
ols.sourceforge.net/#tkruler

On 23 Oct 2007 21:32:21 +0200, Slaven Rezic <slavenrezic.de> wrote:

> "H.Merijn Brand" <h.m.brandxs4all.nl> writes:
> 
> > >From a big application, I reduced it to this
test case. Maybe it can be
> > even shorter, but this should do ...
> 
> I can reduce it to:
> 
> #!perl
> use Tk;
> $top = new MainWindow;
> $top->Checkbutton (-variable => $tar)->pack;
> $top->Button(-command => sub {
> 		 $tar = bless {}, "foo";

Oh, even with global variables. I was in fear that it was
closure/lexical scope related.

> 		 $top->destroy;
> 	     })->pack;
> MainLoop;
> __END__
> 
> The error occurs in the line
> 
>     if (strcmp(value,
Tcl_GetString(butPtr->onValuePtr)) == 0) {
> 
> and butPtr->onValuePtr is 0 here. I guess that some
kind of
> destruction cleanup occured here before Tk tried to
access the
> checkbutton value a last time.
> 
> I suggest to not use the same variable as checkbutton
flag and
> blessed object.

That worked.

-- 
H.Merijn Brand         Amsterdam Perl Mongers (http://amsterdam.pm.org/
)
using & porting perl 5.6.2, 5.8.x, 5.10.x  on HP-UX
10.20, 11.00, 11.11,
& 11.23, SuSE 10.1 & 10.2, AIX 5.2, and Cygwin.     
 http://qa.perl.org
http://mirrors.de
velooper.com/hpux/            http://www.test-smoke.org
                        http
://www.goldmark.org/jeff/stupid-disclaimers/