File: mw_segfault.t

package info (click to toggle)
perl-tk 1%3A804.033-2
  • links: PTS
  • area: main
  • in suites: buster
  • size: 34,724 kB
  • ctags: 37,174
  • sloc: ansic: 349,541; perl: 52,192; sh: 17,904; makefile: 5,732; asm: 3,565; ada: 1,681; pascal: 1,089; cpp: 1,006; yacc: 883; cs: 879
file content (46 lines) | stat: -rwxr-xr-x 1,081 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
#!/usr/bin/perl -w

# This is an (automated) variation of https://bugzilla.redhat.com/show_bug.cgi?id=235666
# It segfaults on FreeBSD 7 with 5.10.0, but not with 5.8.8.
#
# The reason is an already known problem: destroying a MainWindow
# removes some parts of the interpreter which is strictly needed by
# subsequent MainWindows.

use strict;

use Test::More;
plan tests => 1;

use Tk;

sub yes_no{
  my $OKMOD;
  my $Alerte = MainWindow->new(
  		-title      =>	"Yes or No",
  		);
  
  my $BMOD = $Alerte->Button(
  		-text        =>	"Yes",
		-background  => "green",
  		-command     => sub{$OKMOD = 1; $Alerte->destroy() }
  		)->pack(-side=>	'left',	-expand=>1);
 
  my $BFIN = $Alerte->Button(
  		-text        =>	"No",
  		-background  => "red",
  		-command     => sub{$OKMOD = 0; $Alerte->destroy() }
  		)->pack(-side=>'left',	-expand=>1);
  $BMOD->afterIdle(sub { $BMOD->invoke });
  MainLoop;
  return $OKMOD;
}

my $n = 1000;
diag "Creating and destroying $n MainWindows. This may take some time...";
for(1..$n) {
    yes_no('test'); 
}
pass 'No segfault';

__END__