view release on metacpan or  search on metacpan

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

    eval { $wrapper->wrapped({a => 1}) };
    like($@, qr/Type constraint failed/, 'Object rejects plain hashref');

    eval { $wrapper->wrapped('string') };
    like($@, qr/Type constraint failed/, 'Object rejects string');

    # Object accepts any blessed reference
    my $blessed_array = bless [], 'SomeClass';
    $wrapper->wrapped($blessed_array);
    isa_ok($wrapper->wrapped, 'SomeClass', 'Object accepts any blessed ref');
};

# ==== Bool Edge Cases ====

subtest 'Bool edge cases' => sub {
    object::define('BoolClass', 'flag:Bool');

    my $obj = new BoolClass;

    # Standard booleans
    $obj->flag(1);
    is($obj->flag, 1, 'Bool accepts 1');

    $obj->flag(0);
    is($obj->flag, 0, 'Bool accepts 0');

    $obj->flag('');
    is($obj->flag, '', 'Bool accepts empty string');

    # Bool rejects non-0/1 integers
    eval { $obj->flag(2) };
    like($@, qr/Type constraint failed/, 'Bool rejects 2');

    # Bool accepts truthy values (Perl-style boolean)
    $obj->flag('true');
    ok($obj->flag, 'Bool accepts "true" string (truthy)');

    $obj->flag([]);
    ok(ref($obj->flag) eq 'ARRAY', 'Bool accepts arrayref (truthy)');
};

# ==== Int Edge Cases ====

subtest 'Int edge cases' => sub {
    object::define('IntClass', 'num:Int');

    my $obj = new IntClass num => 0;

    is($obj->num, 0, 'Int accepts 0');

    $obj->num(-999);
    is($obj->num, -999, 'Int accepts negative');

    $obj->num(999999999);
    is($obj->num, 999999999, 'Int accepts large positive');

    # Float should be rejected or truncated
    eval { $obj->num(3.14) };
    like($@, qr/Type constraint failed/, 'Int rejects float');

    # String that looks like int
    $obj->num('42');
    is($obj->num, '42', 'Int accepts numeric string');

    eval { $obj->num('42.5') };
    like($@, qr/Type constraint failed/, 'Int rejects decimal string');
};

# ==== Num Edge Cases ====

subtest 'Num edge cases' => sub {
    object::define('NumClass', 'value:Num');

    my $obj = new NumClass value => 0;

    $obj->value(3.14159);
    ok(abs($obj->value - 3.14159) < 0.00001, 'Num accepts float');

    $obj->value(-273.15);
    ok(abs($obj->value - -273.15) < 0.00001, 'Num accepts negative float');

    $obj->value(1e10);
    is($obj->value, 1e10, 'Num accepts scientific notation');

    $obj->value('123.456');
    ok(abs($obj->value - 123.456) < 0.00001, 'Num accepts numeric string');
};

# ==== Default Expression Freshness ====

subtest 'default array freshness' => sub {
    object::define('ArrayDefaultClass', 'items:ArrayRef:default([])');

    my $obj1 = new ArrayDefaultClass;
    my $obj2 = new ArrayDefaultClass;

    push @{$obj1->items}, 'item1';
    is_deeply($obj1->items, ['item1'], 'first object has item');
    is_deeply($obj2->items, [], 'second object still empty (fresh array)');

    # Verify they're different references
    ok($obj1->items != $obj2->items, 'different array references');
};

subtest 'default hash freshness' => sub {
    object::define('HashDefaultClass', 'data:HashRef:default({})');

    my $obj1 = new HashDefaultClass;
    my $obj2 = new HashDefaultClass;

    $obj1->data->{key} = 'value';
    is_deeply($obj1->data, {key => 'value'}, 'first object has key');
    is_deeply($obj2->data, {}, 'second object still empty (fresh hash)');

    ok($obj1->data != $obj2->data, 'different hash references');
};

subtest 'default undef' => sub {
    object::define('UndefDefaultClass', 'value:Any:default(undef)');

    my $obj = new UndefDefaultClass;