diff --git a/t/20-special-values.t b/t/20-special-values.t new file mode 100644 index 0000000..c4725f2 --- /dev/null +++ b/t/20-special-values.t @@ -0,0 +1,254 @@ +use strict; +use warnings; + +use Test::More tests => 33; + +# ============================================================= +# Test accessor behavior with special Perl values and edge-case +# attribute names that exercise unusual but valid code paths: +# - Reference values (hashref, arrayref, coderef, blessed, regex) +# - Underscore-prefixed attributes (double-underscore hooks) +# - Object independence (no cross-talk between instances) +# - Builders returning references +# - Hook interaction with reference values +# ============================================================= + +# --- Reference values: store and retrieve various ref types --- +{ + package RefStore; + use Simple::Accessor qw{hash_val array_val code_val obj_val regex_val}; + + package main; + + my $href = { a => 1, b => 2 }; + my $aref = [10, 20, 30]; + my $cref = sub { 'hello' }; + my $obj = bless { id => 42 }, 'SomeClass'; + my $regex = qr/^foo\d+$/; + + my $o = RefStore->new( + hash_val => $href, + array_val => $aref, + code_val => $cref, + obj_val => $obj, + regex_val => $regex, + ); + + is_deeply $o->hash_val, $href, 'hashref round-trips through constructor'; + is_deeply $o->array_val, $aref, 'arrayref round-trips through constructor'; + is $o->code_val, $cref, 'coderef round-trips through constructor'; + is $o->obj_val, $obj, 'blessed ref round-trips through constructor'; + is $o->regex_val, $regex, 'regex ref round-trips through constructor'; + + # verify the coderef is callable + is $o->code_val->(), 'hello', 'stored coderef is callable'; + + # update reference value via setter + my $new_href = { x => 99 }; + $o->hash_val($new_href); + is_deeply $o->hash_val, $new_href, 'hashref updated via setter'; +} + +# --- Builder returning a reference --- +{ + package RefBuilder; + use Simple::Accessor qw{config items}; + + my $config_calls = 0; + + sub _build_config { + $config_calls++; + return { debug => 0, verbose => 1 }; + } + + sub _build_items { [qw(alpha beta gamma)] } + + sub config_call_count { $config_calls } + + package main; + + my $o = RefBuilder->new(); + is_deeply $o->config, { debug => 0, verbose => 1 }, + 'builder returning hashref works'; + is_deeply $o->items, [qw(alpha beta gamma)], + 'builder returning arrayref works'; + + # builder fires only once (reference is stored) + $o->config; + is( RefBuilder->config_call_count(), 1, + 'builder returning ref fires only once' ); +} + +# --- Hooks receive and validate reference values --- +{ + package RefHooks; + use Simple::Accessor qw{data}; + + sub _validate_data { + my ($self, $v) = @_; + return ref $v eq 'HASH' ? 1 : 0; + } + + sub _before_data { + my ($self, $v) = @_; + return 1; + } + + package main; + + my $o = RefHooks->new(); + $o->data({ key => 'val' }); + is_deeply $o->data, { key => 'val' }, + 'validate hook accepts hashref'; + + $o->data([1, 2, 3]); + is_deeply $o->data, { key => 'val' }, + 'validate hook rejects non-hashref (arrayref), old value kept'; + + $o->data('string'); + is_deeply $o->data, { key => 'val' }, + 'validate hook rejects non-hashref (string), old value kept'; +} + +# --- After-hook rollback with reference values --- +{ + package RefRollback; + use Simple::Accessor qw{payload}; + + sub _after_payload { + my ($self, $v) = @_; + # reject arrayrefs, accept everything else + return ref $v eq 'ARRAY' ? 0 : 1; + } + + package main; + + my $original = { status => 'ok' }; + my $o = RefRollback->new(payload => $original); + is_deeply $o->payload, $original, 'initial reference value set'; + + $o->payload([1, 2, 3]); + is_deeply $o->payload, $original, + 'after-hook rollback restores original reference on rejection'; + + my $new_hash = { status => 'updated' }; + $o->payload($new_hash); + is_deeply $o->payload, $new_hash, + 'after-hook allows non-arrayref reference'; +} + +# --- Underscore-prefixed attribute: double-underscore hooks --- +{ + package PrivateAttr; + use Simple::Accessor qw{_data _count}; + + my $validate_called = 0; + + # hook name: _build_ + _data = _build__data (double underscore) + sub _build__data { 'default-data' } + + # hook name: _validate_ + _data = _validate__data + sub _validate__data { + my ($self, $v) = @_; + $validate_called++; + return length($v) > 0 ? 1 : 0; + } + + sub _build__count { 0 } + + sub validate_call_count { $validate_called } + + package main; + + my $o = PrivateAttr->new(); + is $o->_data, 'default-data', + 'underscore-prefix attr: builder _build__data fires'; + is $o->_count, 0, + 'underscore-prefix attr: builder _build__count fires'; + + $o->_data('new-value'); + is $o->_data, 'new-value', + 'underscore-prefix attr: setter works'; + is( PrivateAttr->validate_call_count(), 1, + 'underscore-prefix attr: _validate__data hook fires' ); + + $o->_data(''); + is $o->_data, 'new-value', + 'underscore-prefix attr: _validate__data rejects empty string'; +} + +# --- Object independence: no cross-talk between instances --- +{ + package IndependentObj; + use Simple::Accessor qw{name score}; + + sub _build_score { 0 } + + package main; + + my $a = IndependentObj->new(name => 'Alice'); + my $b = IndependentObj->new(name => 'Bob'); + + is $a->name, 'Alice', 'instance A has its own name'; + is $b->name, 'Bob', 'instance B has its own name'; + + $a->score(100); + is $a->score, 100, 'instance A score set to 100'; + is $b->score, 0, 'instance B score unaffected (builder default)'; + + $b->score(200); + is $a->score, 100, 'instance A score still 100 after B update'; + is $b->score, 200, 'instance B score updated to 200'; + + # reference value independence: modifying one shouldn't affect the other + my $a_data = { key => 'a' }; + my $b_data = { key => 'b' }; + $a->name($a_data); + $b->name($b_data); + $a_data->{key} = 'modified'; + is $a->name->{key}, 'modified', + 'instance A reflects mutation of stored reference'; + is $b->name->{key}, 'b', + 'instance B reference is independent from A'; +} + +# --- Overloaded object as attribute value --- +{ + package OverloadedVal; + use overload + '""' => sub { "stringified:" . $_[0]->{val} }, + 'bool' => sub { 1 }, + fallback => 1; + + sub new { bless { val => $_[1] }, $_[0] } + + package OverloadConsumer; + use Simple::Accessor qw{tag}; + + package main; + + my $ov = OverloadedVal->new('test'); + my $o = OverloadConsumer->new(tag => $ov); + is ref($o->tag), 'OverloadedVal', + 'overloaded object stored as-is (not stringified)'; + is "${\$o->tag}", 'stringified:test', + 'overloaded stringification works on retrieved value'; +} + +# --- Builder returning blessed object --- +{ + package ObjBuilder; + use Simple::Accessor qw{engine}; + + sub _build_engine { + return bless { type => 'v8' }, 'Engine'; + } + + package main; + + my $o = ObjBuilder->new(); + isa_ok $o->engine, 'Engine', + 'builder returning blessed ref preserves class'; + is $o->engine->{type}, 'v8', + 'builder-returned object has correct data'; +}