Skip to content

Commit b6bb433

Browse files
committed
t/class/accessor.t - add additional :reader and :writer tests
The :reader tests are not really needed at present, as `pp_leavesub` makes the necessary copies, but exploring some fast accessor ideas which bypass that logic has shown the usefulness of having these tests present. A test for :writer on an array field already exists in a separate file. A comment pointing to that file has been added, and a test for the hash case added next to the pre-existing test.
1 parent 201ee5d commit b6bb433

File tree

2 files changed

+34
-1
lines changed

2 files changed

+34
-1
lines changed

t/class/accessor.t

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,10 @@ no warnings 'experimental::class';
1919
field @a :reader = qw( the array );
2020

2121
# Present-but-empty parens counts as default
22+
2223
field %h :reader() = qw( the hash );
24+
25+
field $empty :reader;
2326
}
2427

2528
my $o = Testcase1->new;
@@ -35,12 +38,24 @@ no warnings 'experimental::class';
3538
'Reader accessor fails with argument');
3639
like($@, qr/^Too many arguments for subroutine \'Testcase1::s\' \(got 2; expected 1\) at /,
3740
'Failure from argument to accessor');
41+
42+
# Reading an undefined value has predictable behaviour
43+
is(scalar $o->empty, undef, 'scalar :reader on uninitialized field is undef');
44+
my ($empty) = $o->empty;
45+
is($empty, undef, 'list :reader on uninitialized field is undef');
46+
47+
# :reader returns value copies, not the internal SVs
48+
map { $_ = 99 } $o->s, $o->a, $o->h;
49+
is($o->s, "the scalar", ':reader does not expose internal SVs');
50+
ok(eq_array([$o->a], [qw( the array )]), ':reader does not expose internal AVs');
51+
ok(eq_hash({$o->h}, {qw( the hash )}), ':reader does not expose internal HVs');
3852
}
3953

4054
# writer accessors on scalars
4155
{
4256
class Testcase2 {
4357
field $s :reader :writer = "initial";
58+
field $xno :param :reader = "Eh-ehhh";
4459
}
4560

4661
my $o = Testcase2->new;
@@ -57,6 +72,12 @@ no warnings 'experimental::class';
5772
'Writer accessor fails with 2 arguments');
5873
like($@, qr/^Too many arguments for subroutine \'Testcase2::set_s\' \(got 3; expected 2\) at /,
5974
'Failure from argument to accessor');
75+
76+
# Should not be able to write without the :writer attribute
77+
ok(!eval { $o->set_xno(77) },
78+
'Cannot write without :writer attribute');
79+
like($@, qr/^Can\'t locate object method \"set_xno\" via package \"Testcase2\"/,
80+
'Failure from writing without :writer');
6081
}
6182

6283
# Alternative names
@@ -76,4 +97,6 @@ no warnings 'experimental::class';
7697
'Failure from lack of original name accessor');
7798
}
7899

100+
# Note: see t/lib/croak/class for testing :writer accessors on AVs or HVs
101+
79102
done_testing;

t/lib/croak/class

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -175,7 +175,7 @@ class XXX {
175175
EXPECT
176176
"set-abc-def" is not a valid name for a generated method at - line 6.
177177
########
178-
# Writer on non-scalar field
178+
# Writer on array field
179179
use v5.36;
180180
use feature 'class';
181181
no warnings 'experimental::class';
@@ -185,6 +185,16 @@ class XXX {
185185
EXPECT
186186
Cannot apply a :writer attribute to a non-scalar field at - line 6.
187187
########
188+
# Writer on hash field
189+
use v5.36;
190+
use feature 'class';
191+
no warnings 'experimental::class';
192+
class XXX {
193+
field %things :writer;
194+
}
195+
EXPECT
196+
Cannot apply a :writer attribute to a non-scalar field at - line 6.
197+
########
188198
use v5.36;
189199
use feature 'class';
190200
no warnings 'experimental::class';

0 commit comments

Comments
 (0)