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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
#!env perl -w
#
# message logging.
#
use strict;
use warnings;
use Data::Dumper;
use Test::More;
use Glib;
use Config;
if ($Config{archname} =~ m/^(x86_64|mipsel|mips|alpha)/
and not Glib->CHECK_VERSION (2,2,4)) {
# there is a bug in glib which makes g_log print messages twice
# on 64-bit x86 platforms. yosh has fixed this on the 2.2.x branch
# and in 2.4.0 (actually 2.3.2).
# we don't have versioning API in Glib (yet), so we'll just
# have to bail out.
plan skip_all => "g_log doubles messages by accident on 64-bit platforms";
} else {
plan tests => 11;
}
package Foo;
use Glib::Object::Subclass
'Glib::Object';
package main;
$SIG{__WARN__} = sub { ok(1, "in __WARN__: $_[0]"); };
#$SIG{__DIE__} = sub { ok(1, 'in __DIE__'); };
Glib->message (undef, 'whee message');
eval {
Glib->critical (undef, 'whee critical');
Glib->warning (undef, 'whee warning');
};
my $id =
Glib::Log->set_handler (__PACKAGE__,
[qw/ error critical warning message info debug /],
sub {
ok(1, "in custom handler $_[1][0]");
});
Glib->message (__PACKAGE__, 'whee message');
eval {
Glib->critical (__PACKAGE__, 'whee critical');
Glib->warning (__PACKAGE__, 'whee warning');
Glib->log (__PACKAGE__, qw/ warning /, 'whee log warning');
Glib::Log->remove_handler (__PACKAGE__, $id);
};
$id =
Glib::Log->set_handler (undef,
[qw/ error critical warning message info debug /],
sub {
ok(1, "in custom handler $_[1][0]");
});
Glib->log (undef, [qw/ info debug /], 'whee log warning');
Glib::Log->remove_handler (undef, $id);
# i would expect this to call croak, but it actually just aborts. :-(
#eval { Glib->error (__PACKAGE__, 'error'); };
# when you try to connect to a non-existant signal, you get a CRITICAL
# log message...
my $object = Foo->new;
{
ok(1, 'attempting to connect a non-existant signal');
local $SIG{__WARN__} = sub { ok( $_[0] =~ /nonexistant/, 'should warn' ); };
$object->signal_connect (nonexistant => sub { ok(0, "shouldn't get here") });
delete $SIG{__WARN__};
}
## try that again with a fatal mask
#Glib::Log->set_always_fatal (['critical', 'fatal-mask']);
#{
#local $SIG{__DIE__} = sub { ok(1, 'should die'); };
#eval {
#$object->signal_connect (nonexistant => sub { ok(0, "shouldn't get here") });
#};
#print "$@\n";
#}
Glib::Log->set_fatal_mask (__PACKAGE__, [qw/ warning message /]);
Glib::Log->set_always_fatal ([qw/ info debug /]);
__END__
Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the
full list)
This library is free software; you can redistribute it and/or modify it under
the terms of the GNU Library General Public License as published by the Free
Software Foundation; either version 2.1 of the License, or (at your option) any
later version.
This library 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 Library General Public License for more
details.
You should have received a copy of the GNU Library General Public License along
with this library; if not, write to the Free Software Foundation, Inc., 59
Temple Place - Suite 330, Boston, MA 02111-1307 USA.
|
