view release on metacpan or  search on metacpan

t/4007-object-edge-cases.t  view on Meta::CPAN

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

use object;

# ==== Undef and Empty Values ====

subtest 'undef handling' => sub {
    object::define('NullableClass',
        'value:Any',
        'str:Str',
    );

    # Any type accepts undef
    my $obj = new NullableClass value => undef;
    ok(!defined($obj->value), 'Any accepts undef on construction');

    $obj->value(undef);
    ok(!defined($obj->value), 'Any accepts undef on setter');

    # Str rejects undef (requires defined non-ref)
    eval { $obj->str(undef) };
    like($@, qr/Type constraint failed/, 'Str rejects undef');
};

subtest 'empty string handling' => sub {
    object::define('EmptyStrClass',
        'name:Str',
        'value:Any',
    );

    my $obj = new EmptyStrClass name => '', value => '';
    is($obj->name, '', 'Str accepts empty string');
    is($obj->value, '', 'Any accepts empty string');
};

# ==== Unicode ====

subtest 'unicode values' => sub {
    object::define('UnicodeClass', 'text:Str');

    my $unicode = "\x{1F600}\x{1F4A9}";  # emoji
    my $obj = new UnicodeClass text => $unicode;
    is($obj->text, $unicode, 'Str preserves unicode emoji');

    my $japanese = "\x{65E5}\x{672C}\x{8A9E}";  # Japanese
    $obj->text($japanese);
    is($obj->text, $japanese, 'Str preserves Japanese characters');

    my $arabic = "\x{0627}\x{0644}\x{0639}\x{0631}\x{0628}\x{064A}\x{0629}";
    $obj->text($arabic);
    is($obj->text, $arabic, 'Str preserves Arabic characters');
};

# ==== Any Type ====

subtest 'Any type' => sub {
    object::define('AnyClass', 'data:Any');

    my $obj = new AnyClass;

    # Any accepts anything
    $obj->data(42);
    is($obj->data, 42, 'Any accepts integer');

    $obj->data('string');
    is($obj->data, 'string', 'Any accepts string');

    $obj->data([1,2,3]);
    is_deeply($obj->data, [1,2,3], 'Any accepts arrayref');

    $obj->data({a => 1});
    is_deeply($obj->data, {a => 1}, 'Any accepts hashref');

    $obj->data(sub { 42 });
    is($obj->data->(), 42, 'Any accepts coderef');

    $obj->data(undef);
    ok(!defined($obj->data), 'Any accepts undef');
};

# ==== Defined Type ====

subtest 'Defined type' => sub {
    object::define('DefinedClass', 'value:Defined');

    my $obj = new DefinedClass value => 0;
    is($obj->value, 0, 'Defined accepts 0');

    $obj->value('');
    is($obj->value, '', 'Defined accepts empty string');

    $obj->value([]);
    is_deeply($obj->value, [], 'Defined accepts empty arrayref');

    eval { $obj->value(undef) };
    like($@, qr/Type constraint failed/, 'Defined rejects undef');

    eval { new DefinedClass value => undef };
    like($@, qr/Type constraint failed/, 'Defined rejects undef in constructor');
};

# ==== Object Type ====