view release on metacpan or  search on metacpan

t/1079-util-callbacks-xs.t  view on Meta::CPAN

    eval { util::final_cb('not_array', ':is_positive') };
    like($@, qr/arrayref/, 'final_cb requires arrayref');
};

# ============================================
# Test Perl-level callback registration
# ============================================

subtest 'Perl callback registration' => sub {
    # Register a custom Perl predicate
    util::register_callback('is_long_string', sub { length($_[0]) > 5 });
    
    ok(util::has_callback('is_long_string'), 'callback registered');
    
    my @strings = ('hi', 'hello', 'goodbye', 'x', 'testing');
    
    is(util::count_cb(\@strings, 'is_long_string'), 2, 'count long strings');
    is(util::first_cb(\@strings, 'is_long_string'), 'goodbye', 'first long string');
    
    my @long = util::grep_cb(\@strings, 'is_long_string');
    is_deeply(\@long, ['goodbye', 'testing'], 'grep long strings');
};

subtest 'Cannot re-register callback' => sub {
    eval { util::register_callback(':is_positive', sub { 1 }) };
    like($@, qr/already registered/, 'cannot re-register built-in');
    
    eval { util::register_callback('is_long_string', sub { 1 }) };
    like($@, qr/already registered/, 'cannot re-register user callback');
};

subtest 'Unknown callback error' => sub {
    eval { util::any_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'any_cb with unknown callback dies');
    
    eval { util::all_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'all_cb with unknown callback dies');
    
    eval { util::none_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'none_cb with unknown callback dies');
    
    eval { util::first_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'first_cb with unknown callback dies');
    
    eval { util::grep_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'grep_cb with unknown callback dies');
    
    eval { util::count_cb([1,2,3], 'nonexistent') };
    like($@, qr/unknown callback/, 'count_cb with unknown callback dies');
};

subtest 'Invalid arguments' => sub {
    eval { util::any_cb('not_array', ':is_positive') };
    like($@, qr/arrayref/, 'any_cb requires arrayref');
    
    eval { util::any_cb({}, ':is_positive') };
    like($@, qr/arrayref/, 'any_cb rejects hashref');
};

# ============================================
# Test list_callbacks returns all
# ============================================

subtest 'list_callbacks' => sub {
    my $callbacks = util::list_callbacks();
    ok(ref $callbacks eq 'ARRAY', 'returns arrayref');
    
    # Should have all built-ins
    my %cb = map { $_ => 1 } @$callbacks;
    ok($cb{':is_defined'}, 'has :is_defined');
    ok($cb{':is_positive'}, 'has :is_positive');
    ok($cb{':is_array'}, 'has :is_array');
    ok($cb{':is_even'}, 'has :is_even');
    ok($cb{'is_long_string'}, 'has user-registered callback');
};

# ============================================
# Test has_callback
# ============================================

subtest 'has_callback' => sub {
    ok(util::has_callback(':is_positive'), 'has built-in');
    ok(util::has_callback('is_long_string'), 'has user callback');
    ok(!util::has_callback('nonexistent'), 'does not have nonexistent');
    ok(!util::has_callback(':fake'), 'does not have :fake');
};

# ============================================
# Performance sanity check - C path should be fast
# ============================================

subtest 'Performance sanity' => sub {
    my @large = (1) x 10000;
    
    # This should complete in reasonable time
    my $start = time();
    for (1..100) {
        util::any_cb(\@large, ':is_positive');
        util::all_cb(\@large, ':is_positive');
        util::count_cb(\@large, ':is_positive');
    }
    my $elapsed = time() - $start;
    
    ok($elapsed < 5, "C predicate path is fast (${elapsed}s for 300 calls on 10k elements)");
};

done_testing();