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
|
#!/usr/bin/env perl
BEGIN { require './t/inc/setup.pl' };
use strict;
use warnings;
plan tests => 34;
{
package GoodImplementation;
use Glib::Object::Subclass 'GI::Object';
sub METHOD_INT8_IN {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
}
sub METHOD_INT8_OUT {
my ($self) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
return 42;
}
}
{
my $foo = GoodImplementation->new;
$foo->method_int8_in (23);
pass;
is ($foo->method_int8_out, 42);
$foo->method_with_default_implementation (23);
is ($foo->get ('int'), 23);
}
{
package GoodChaining;
use Glib::Object::Subclass 'GI::Object';
sub METHOD_INT8_IN {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
# cannot chain up since GI::Object does not provide a default
# implementation
}
sub METHOD_INT8_OUT {
my ($self) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
# cannot chain up since GI::Object does not provide a default
# implementation
return 42;
}
sub METHOD_WITH_DEFAULT_IMPLEMENTATION {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
return $self->SUPER::METHOD_WITH_DEFAULT_IMPLEMENTATION ($int8);
}
}
{
my $foo = GoodChaining->new;
$foo->method_int8_in (23);
pass;
$foo->method_with_default_implementation (23);
is ($foo->get ('int'), 23);
}
{
package PerlInheritance;
use Glib::Object::Subclass 'GoodImplementation';
}
{
my $foo = PerlInheritance->new;
$foo->method_int8_in (23);
pass;
is ($foo->method_int8_out, 42);
$foo->method_with_default_implementation (23);
is ($foo->get ('int'), 23);
}
{
package PerlInheritanceWithChaining;
use Glib::Object::Subclass 'GoodChaining';
sub METHOD_INT8_IN {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
return $self->SUPER::METHOD_INT8_IN ($int8);
}
sub METHOD_INT8_OUT {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
return $self->SUPER::METHOD_INT8_OUT ();
}
sub METHOD_WITH_DEFAULT_IMPLEMENTATION {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
return $self->SUPER::METHOD_WITH_DEFAULT_IMPLEMENTATION ($int8);
}
}
{
my $foo = PerlInheritanceWithChaining->new;
$foo->method_int8_in (23);
pass;
is ($foo->method_int8_out, 42);
$foo->method_with_default_implementation (23);
is ($foo->get ('int'), 23);
}
{
package BadChaininig;
use Glib::Object::Subclass 'GI::Object';
sub METHOD_INT8_IN {
my ($self, $int8) = @_;
Test::More::isa_ok ($self, __PACKAGE__);
Test::More::is ($int8, 23);
return $self->SUPER::METHOD_INT8_IN ($int8);
}
}
{
my $foo = BadChaininig->new;
local $@;
eval { $foo->method_int8_in (23) };
like ($@, qr/METHOD_INT8_IN/);
}
=for segfault
This segfaults currently because the call to method_int8_in tries to invoke the
corresponding vfunc slot in the class struct for NoImplementation. But that's
NULL since NoImplementation doesn't provide an implementation.
{
package NoImplementation;
use Glib::Object::Subclass 'GI::Object';
}
{
my $foo = NoImplementation->new;
local $@;
eval { $foo->method_int8_in (23) };
like ($@, qr/method_int8_in/);
}
=cut
|
