Gtk2-Ex-ErrorTextDialog
view release on metacpan or search on metacpan
devel/message-text-fallback.t view on Meta::CPAN
is ($fake_text_property_called, 0,
"fake find_property('text') not further called");
diag "call _message_dialog_set_text again";
$fake_text_property_called = 0;
Gtk2::Ex::ErrorTextDialog::_message_dialog_set_text($dialog,'mess2');
is ($fake_text_property_called, 0,
"fake find_property('text') not further called");
$dialog->show_all;
main_iterations();
Glib::Timeout->add (2000, sub { Gtk2->main_quit;
return 0; # Glib::SOURCE_REMOVE
});
Gtk2->main;
$dialog->destroy;
exit 0;
t/ErrorTextDialog.t view on Meta::CPAN
#-----------------------------------------------------------------------------
# Scalar::Util::weaken
diag "Scalar::Util::weaken";
{
my $dialog = Gtk2::Ex::ErrorTextDialog->new;
require Scalar::Util;
Scalar::Util::weaken ($dialog);
$dialog->destroy;
MyTestHelpers::main_iterations ();
is ($dialog, undef, 'garbage collect after destroy');
}
#-----------------------------------------------------------------------------
# instance()
{
my $instance = Gtk2::Ex::ErrorTextDialog->instance;
isa_ok ($instance, 'Gtk2::Ex::ErrorTextDialog');
my $i2 = Gtk2::Ex::ErrorTextDialog->instance;
t/MyTestHelpers.pm view on Meta::CPAN
package MyTestHelpers;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
# uncomment this to run the ### lines
#use Smart::Comments;
@ISA = ('Exporter');
@EXPORT_OK = qw(findrefs
main_iterations
warn_suppress_gtk_icon
glib_gtk_versions
any_signal_connections
nowarnings);
%EXPORT_TAGS = (all => \@EXPORT_OK);
sub DEBUG { 0 }
#-----------------------------------------------------------------------------
t/MyTestHelpers.pm view on Meta::CPAN
MyTestHelpers::diag ("search ", $proberef);
MyTestHelpers::findrefs($proberef);
}
}
#-----------------------------------------------------------------------------
# Gtk/Glib helpers
# Gtk 2.16 can go into a hard loop on events_pending() / main_iteration_do()
# if dbus is not running, or something like that. In any case limiting the
# iterations is good for test safety.
#
sub main_iterations {
my $count = 0;
if (DEBUG) { MyTestHelpers::diag ("main_iterations() ..."); }
while (Gtk2->events_pending) {
$count++;
Gtk2->main_iteration_do (0);
if ($count >= 500) {
MyTestHelpers::diag ("main_iterations(): oops, bailed out after $count events/iterations");
return;
}
}
MyTestHelpers::diag ("main_iterations(): ran $count events/iterations");
}
# warn_suppress_gtk_icon() is a $SIG{__WARN__} handler which suppresses spam
# from Gtk trying to make you buy the hi-colour icon theme. Eg,
#
# {
# local $SIG{'__WARN__'} = \&MyTestHelpers::warn_suppress_gtk_icon;
# $something = SomeThing->new;
# }
#
t/MyTestHelpers.pm view on Meta::CPAN
# in Gtk 2.0 gdk_flush() is a sync actually
Gtk2::Gdk->flush;
}
my $count = 0;
while (! $done) {
if (DEBUG >= 2) { MyTestHelpers::diag ("wait_for_event() iteration $count"); }
Gtk2->main_iteration;
$count++;
}
MyTestHelpers::diag ("wait_for_event(): '$signame' ran $count events/iterations\n");
$widget->signal_handler_disconnect ($sig_id);
Glib::Source->remove ($timer_id);
}
#-----------------------------------------------------------------------------
# X11::Protocol helpers
sub X11_chosen_screen_number {
t/SaveDialog.t view on Meta::CPAN
$dialog->set_transient_for ($errdialog);
require File::Temp;
my $fh = File::Temp->new;
my $filename = $fh->filename;
diag "temp file $filename";
# for some very dubious reason set_current_name() doesn't work until the
# dialog is shown, and not just realized either, :-(
$dialog->show;
MyTestHelpers::main_iterations ();
$dialog->set_current_name($filename);
is ($dialog->get_filename, $filename, "filename set into dialog: $filename");
SKIP: {
$dialog->get_filename eq $filename
or skip "filename not set correctly into dialog, don't want to overwrite something else", 1;
$dialog->save;
my $str = do { local $/ = undef; <$fh> }; # slurp
is ($str, "hello\n", "saved to $filename");
}
t/SaveDialog.t view on Meta::CPAN
# destroy and weaken
{
my $dialog = do {
local $SIG{'__WARN__'} = \&MyTestHelpers::warn_suppress_gtk_icon;
Gtk2::Ex::ErrorTextDialog::SaveDialog->new;
};
require Scalar::Util;
Scalar::Util::weaken ($dialog);
$dialog->destroy;
MyTestHelpers::main_iterations ();
is ($dialog, undef, 'garbage collect after destroy');
}
exit 0;
t/test-weaken.t view on Meta::CPAN
#-----------------------------------------------------------------------------
# ErrorTextDialog
diag "on new() ErrorTextDialog";
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $dialog = Gtk2::Ex::ErrorTextDialog->new;
$dialog->realize;
MyTestHelpers::main_iterations ();
return $dialog;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
diag "on instance() ErrorTextDialog";
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $dialog = Gtk2::Ex::ErrorTextDialog->instance;
$dialog->realize;
MyTestHelpers::main_iterations ();
return $dialog;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection');
MyTestHelpers::test_weaken_show_leaks($leaks);
}
# with save dialog
{
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $error_dialog = Gtk2::Ex::ErrorTextDialog->new;
my $save_dialog = do {
local $SIG{'__WARN__'} = \&MyTestHelpers::warn_suppress_gtk_icon;
$error_dialog->_save_dialog
};
$error_dialog->present;
$save_dialog->present;
MyTestHelpers::main_iterations ();
return [ $error_dialog, $save_dialog ];
},
# $save_dialog is destroy-with-parent, so destructor only on
# $error_dialog
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef,
'Test::Weaken deep garbage collection -- with save dialog too');
MyTestHelpers::test_weaken_show_leaks($leaks);
( run in 1.744 second using v1.01-cache-2.11-cpan-71847e10f99 )