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
|
#
# test Glib::Object derivation in Perl.
# derive from a C object in perl, and derive from a Perl object in perl.
# checks order of execution of initializers and finalizers, so the code
# gets a little hairy.
#
print "1..12\n";
use strict;
use warnings;
use Glib;
print "ok 1\n";
my $init_self;
sub Foo::INIT_INSTANCE {
$init_self = $_[0]*1;
print "ok 2\n";
}
sub Foo::FINALIZE_INSTANCE {
print "ok 9\n";
}
my $setprop_self;
sub Foo::SET_PROPERTY {
$setprop_self = $_[0]*1;
print "ok $_[2]\n";
}
sub Foo::GET_PROPERTY {
print "ok 6\n";
6;
}
register Glib::Type
Glib::Object::, Foo::,
properties => [
Glib::ParamSpec->string (
'some_string',
'Some String Property',
'This property is a string that is used as an example',
'default value',
[qw/readable writable/]
),
];
sub Bar::INIT_INSTANCE {
print "ok 3\n";
}
sub Bar::FINALIZE_INSTANCE {
print "ok 8\n";
}
Glib::Type->register (Foo::, Bar::,
properties => [
Glib::ParamSpec->int ('number', 'some number',
'number in bar but not in foo',
0, 10, 0, ['readable']),
]);
{
# instantiate a child. we should get messages from both initializers.
my $bar = new Bar;
use POSIX;
# make sure we can set parent properties on the child
$bar->set(some_string => 4);
print $init_self != $setprop_self ? "not " : "", "ok 5\n";
print $bar->get("some_string") != 6 ? "not " : "", "ok 7\n";
# should see messages from both finalizers here.
}
print "ok 10\n";
#
# ensure that any properties added to the subclass were only added to
# the subclass, and not the parent.
#
my @fooprops = Foo->list_properties;
my @barprops = Bar->list_properties;
print "".(@fooprops == 1 ? "ok 11" : "not ok")." # property count for parent\n";
print "".(@barprops == 2 ? "ok 12" : "not ok")." # property count for child\n";
__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.
|
