mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

t/class/accessor.t - add additional :reader and :writer tests

Browse Source 
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.
This commit is contained in:
Richard Leach 2025-10-10 20:54:10 +00:00
parent b3138094d9
commit a2ff23c0fd
2 changed files with 34 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
t/class/accessor.t
View File

@ -19,7 +19,10 @@ no warnings 'experimental::class';
field @a :reader = qw( the array );
# Present-but-empty parens counts as default
field %h :reader() = qw( the hash );
field $empty :reader;
}
my $o = Testcase1->new;
@ -35,12 +38,24 @@ no warnings 'experimental::class';
'Reader accessor fails with argument');
like($@, qr/^Too many arguments for subroutine \'Testcase1::s\' \(got 2; expected 1\) at /,
'Failure from argument to accessor');
# Reading an undefined value has predictable behaviour
is(scalar $o->empty, undef, 'scalar :reader on uninitialized field is undef');
my ($empty) = $o->empty;
is($empty, undef, 'list :reader on uninitialized field is undef');
# :reader returns value copies, not the internal SVs
map { $_ = 99 } $o->s, $o->a, $o->h;
is($o->s, "the scalar", ':reader does not expose internal SVs');
ok(eq_array([$o->a], [qw( the array )]), ':reader does not expose internal AVs');
ok(eq_hash({$o->h}, {qw( the hash )}), ':reader does not expose internal HVs');
}
# writer accessors on scalars
{
class Testcase2 {
field $s :reader :writer = "initial";
field $xno :param :reader = "Eh-ehhh";
}
my $o = Testcase2->new;
@ -57,6 +72,12 @@ no warnings 'experimental::class';
'Writer accessor fails with 2 arguments');
like($@, qr/^Too many arguments for subroutine \'Testcase2::set_s\' \(got 3; expected 2\) at /,
'Failure from argument to accessor');
# Should not be able to write without the :writer attribute
ok(!eval { $o->set_xno(77) },
'Cannot write without :writer attribute');
like($@, qr/^Can\'t locate object method \"set_xno\" via package \"Testcase2\"/,
'Failure from writing without :writer');
}
# Alternative names
@ -76,4 +97,6 @@ no warnings 'experimental::class';
'Failure from lack of original name accessor');
}
# Note: see t/lib/croak/class for testing :writer accessors on AVs or HVs
done_testing;

12
t/lib/croak/class
View File

@ -175,7 +175,7 @@ class XXX {
EXPECT
"set-abc-def" is not a valid name for a generated method at - line 6.
########
# Writer on non-scalar field
# Writer on array field
use v5.36;
use feature 'class';
no warnings 'experimental::class';
@ -185,6 +185,16 @@ class XXX {
EXPECT
Cannot apply a :writer attribute to a non-scalar field at - line 6.
########
# Writer on hash field
use v5.36;
use feature 'class';
no warnings 'experimental::class';
class XXX {
field %things :writer;
}
EXPECT
Cannot apply a :writer attribute to a non-scalar field at - line 6.
########
use v5.36;
use feature 'class';
no warnings 'experimental::class';