view release on metacpan or  search on metacpan

t/99-integration/high-throughput.t  view on Meta::CPAN

#!/usr/bin/env perl
# Test: High throughput pipeline operations
#
# Gated behind RELEASE_TESTING because the assertions are hard
# ops/sec thresholds (>=10k for SET/GET pipelines, >=5k for mixed).
# Those numbers depend on the test environment — a busy CI host or a
# slow VM can dip below the threshold even when the library itself
# is fine, producing false-negative smoker reports. Pipeline
# correctness (commands return, results in order, error objects
# round-trip) is exercised by t/30-pipeline/. Run this with
# RELEASE_TESTING=1 on a quiet box before cutting a release.
use strict;
use warnings;
use Test2::V0;
use Test::Lib;
use Test::Async::Redis qw(skip_without_redis await_f cleanup_keys run);
use Time::HiRes qw(time);

plan skip_all => 'set RELEASE_TESTING=1 to run high-throughput perf assertions'
    unless $ENV{RELEASE_TESTING};

SKIP: {
    my $redis = skip_without_redis();

    subtest 'pipeline throughput SET' => sub {
        my $r = Async::Redis->new(
            host => $ENV{REDIS_HOST} // 'localhost',
        );
        run { $r->connect };

        my $commands = 10_000;

        my $start = time();
        my $pipeline = $r->pipeline;
        for my $i (1..$commands) {
            $pipeline->set("throughput:key:$i", $i);
        }
        my $results = run { $pipeline->execute };
        my $elapsed = time() - $start;

        is(scalar(@$results), $commands, 'all pipeline commands returned');

        my $ops_per_sec = $commands / $elapsed;
        note("$commands pipelined SETs in ${elapsed}s = " . int($ops_per_sec) . " ops/sec");

        ok($ops_per_sec >= 10_000, "pipeline at least 10000 ops/sec (got " . int($ops_per_sec) . ")");

        run { cleanup_keys($r, 'throughput:*') };
        $r->disconnect;
    };

    subtest 'pipeline throughput GET' => sub {
        my $r = Async::Redis->new(
            host => $ENV{REDIS_HOST} // 'localhost',
        );
        run { $r->connect };

        # Set up keys first
        my $setup_pipe = $r->pipeline;
        for my $i (1..1000) {
            $setup_pipe->set("pget:$i", "value$i");
        }
        run { $setup_pipe->execute };

        # Now GET them all
        my $commands = 10_000;