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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
#!/usr/bin/env perl
#
# 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).
plan skip_all => "g_log doubles messages by accident on 64-bit platforms";
} else {
plan tests => 30;
}
package Foo;
use Glib::Object::Subclass
'Glib::Object';
package main;
$SIG{__WARN__} = sub { chomp (my $msg = $_[0]); ok(1, "in __WARN__: $msg"); };
#$SIG{__DIE__} = sub { ok(1, 'in __DIE__'); };
Glib->message (undef, 'whee message');
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');
Glib->critical (__PACKAGE__, 'whee critical');
Glib->warning (__PACKAGE__, 'whee warning');
Glib->log (__PACKAGE__, qw/ warning /, 'whee log warning');
Glib::Log->remove_handler (__PACKAGE__, $id);
SKIP: {
# See <http://bugzilla.gnome.org/show_bug.cgi?id=577137>.
skip 'using multiple log levels breaks g_log on some platforms', 2
if (!Glib->CHECK_VERSION(2, 20, 1) &&
$Config{archname} =~ /powerpc|amd64|s390/);
my $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'); };
Glib::Log::default_handler ('Test-Domain', ['info'], 'ignore this message');
Glib::Log::default_handler ('Test-Domain', ['info'],
'another message to ignore', 'userdata');
SKIP: {
skip "new 2.6 stuff", 18
unless Glib->CHECK_VERSION (2,6,0);
Glib->log ('An-Unknown-Domain', ['info'], 'this is a test message');
is (Glib::Log->set_default_handler(undef),
\&Glib::Log::default_handler,
'default log handler: install undef, prev default');
Glib->log ('An-Unknown-Domain', ['info'], 'this is a test message');
is (Glib::Log->set_default_handler(\&Glib::Log::default_handler),
\&Glib::Log::default_handler,
'default log handler: install default, prev default');
Glib->log ('An-Unknown-Domain', ['info'], 'this is another test message');
# anon subs like $sub1 and $sub2 must refer to something like $x in the
# environment or they're not gc-ed immediately
my $x = 123;
my $sub1 = sub {
my @args = @_;
is (scalar @args, 3, 'sub1 arg count');
is ($args[0], 'An-Unknown-Domain', 'sub1 domain');
isa_ok ($args[1], 'Glib::LogLevelFlags', 'sub1 flags type');
ok ($args[1] == ['info'], 'sub1 flags value');
is ($args[2], 'a message', 'sub1 message');
return $x
};
is (Glib::Log->set_default_handler($sub1),
\&Glib::Log::default_handler,
'default log handler: install sub1, prev default');
Glib->log ('An-Unknown-Domain', ['info'], 'a message');
my $sub2 = sub {
my @args = @_;
is (scalar @args, 4, 'sub2 arg count');
is ($args[0], 'Another-Unknown-Domain', 'sub2 domain');
isa_ok ($args[1], 'Glib::LogLevelFlags', 'sub2 flags type');
ok ($args[1] == ['warning'], 'sub2 flags value');
is ($args[2], 'a message', 'sub2 message');
is ($args[3], 'some userdata', 'sub2 userdata');
return $x
};
is (Glib::Log->set_default_handler($sub2,'some userdata'), $sub1,
'default log handler: install sub2, prev sub1');
require Scalar::Util;
Scalar::Util::weaken ($sub1);
is ($sub1, undef,
'sub1 garbage collected by weakening');
Glib->log ('Another-Unknown-Domain', ['warning'], 'a message');
is (Glib::Log->set_default_handler(undef), $sub2,
'default log handler: install undef, prev sub2');
Glib->log ('Another-Unknown-Domain', ['info'], 'this is a test message');
is (Glib::Log->set_default_handler(undef),
\&Glib::Log::default_handler,
'default log handler: install undef, prev default');
Glib->log ('Another-Unknown-Domain', ['info'], 'this is yet another a test message');
# test that a custom log handler can safely call the default log handler
Glib::Log->set_default_handler(sub { Glib::Log::default_handler (@_); });
Glib->log ('Another-Unknown-Domain', ['info'], 'custom to default test');
Glib::Log->set_default_handler(undef);
}
# 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";
#}
# Check that messages with % chars make it through unaltered and don't cause
# crashes
{
my $id = Glib::Log->set_handler (
__PACKAGE__,
qw/debug/,
sub { is($_[2], '%s %d %s', 'a message with % chars'); });
Glib->log (__PACKAGE__, qw/debug/, '%s %d %s');
Glib::Log->remove_handler (__PACKAGE__, $id);
}
Glib::Log->set_fatal_mask (__PACKAGE__, [qw/ warning message /]);
Glib::Log->set_always_fatal ([qw/ info debug /]);
__END__
Copyright (C) 2003, 2009 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.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
