view release on metacpan or  search on metacpan

t/4009-object-accessor-behavior.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

use object;

# ==== Accessor Return Values ====

subtest 'getter returns current value' => sub {
    object::define('GetterTest', 'val:Str');

    my $obj = new GetterTest val => 'initial';
    is($obj->val, 'initial', 'getter returns value');

    # Chained assignment
    my $ret = $obj->val('updated');
    is($ret, 'updated', 'setter returns new value');
    is($obj->val, 'updated', 'value was actually set');
};

subtest 'method chaining' => sub {
    object::define('ChainTest', 'a:Str', 'b:Int', 'c:Num');

    my $obj = new ChainTest a => '', b => 0, c => 0.0;

    # Value is returned, allowing use in expressions
    my $res = $obj->a('hello');
    is($res, 'hello', 'setter returns value for chaining');
};

# ==== Constructor Variations ====

subtest 'new with hash' => sub {
    object::define('HashNew', 'x:Int', 'y:Int');

    my %args = (x => 10, y => 20);
    my $obj = new HashNew %args;
    is($obj->x, 10, 'hash args x');
    is($obj->y, 20, 'hash args y');
};

subtest 'new with partial args' => sub {
    object::define('PartialNew',
        'required:Str:required',
        'optional:Str:default(none)',
    );

    my $obj = new PartialNew required => 'yes';
    is($obj->required, 'yes', 'required field set');
    is($obj->optional, 'none', 'optional uses default');
};

# ==== Error Message Quality ====

subtest 'type error messages' => sub {
    object::define('ErrorMsg', 'num:Int');

    eval { new ErrorMsg num => 'not a number' };
    like($@, qr/Int/, 'error mentions expected type');
    like($@, qr/num/, 'error mentions property name');
};

subtest 'required field error' => sub {
    object::define('RequiredError', 'must_have:Str:required');

    eval { new RequiredError };
    like($@, qr/required|must_have/i, 'error for missing required field');
};

subtest 'readonly error' => sub {
    object::define('ReadonlyError', 'fixed:Str:readonly');

    my $obj = new ReadonlyError fixed => 'immutable';
    eval { $obj->fixed('change') };
    like($@, qr/readonly|cannot|modify/i, 'error for modifying readonly');
};

# ==== Property Name Edge Cases ====