view release on metacpan or  search on metacpan

xt/fuzz_structured.t  view on Meta::CPAN

    my ($off, $kind, $width) = @$site;
    substr($bytes, $off, $kind eq 'uvar' ? $width : length $value) = $value;
    return $bytes;
}

my ($checked, $bad) = (0, 0);
sub run_parse {
    my ($desc, $api, $ver, $bytes) = @_;
    $checked++;
    my $r = eval { EV::Kafka::_test_parse_response($api, $ver, $bytes) };
    if ($@) { $bad++; diag "DIE $desc: $@"; return; }
    if (defined $r && ref $r ne 'HASH') {
        $bad++; diag "NON-HASH $desc: " . ref $r;
    }
}
sub run_batch {
    my ($desc, $bytes) = @_;
    $checked++;
    my $r = eval { EV::Kafka::_test_decode_batch($bytes) };
    if ($@) { $bad++; diag "DIE $desc: $@"; return; }
    if (defined $r && ref $r ne 'ARRAY') {
        $bad++; diag "NON-ARRAY $desc: " . ref $r;
    }
}

my @TPL = (
    ['metadata v1',     'metadata',     1, \&tpl_metadata_v1],
    ['metadata v9',     'metadata',     9, \&tpl_metadata_v9],
    ['produce v7',      'produce',      7, \&tpl_produce_v7],
    ['fetch v4',        'fetch',        4, \&tpl_fetch_v4],
    ['fetch v7',        'fetch',        7, \&tpl_fetch_v7],
    ['list_offsets v1', 'list_offsets', 1, \&tpl_list_offsets_v1],
);

# --- Templates must be valid, else the whole exercise is vacuous ---------
{
    my ($bytes) = tpl_metadata_v1();
    my $r = EV::Kafka::_test_parse_response('metadata', 1, $bytes);
    ok((ref $r eq 'HASH') && @{$r->{brokers}} == 1 && @{$r->{topics}} == 1,
        'template metadata v1 parses to expected structure');
}
{
    my ($bytes) = tpl_metadata_v9();
    my $r = EV::Kafka::_test_parse_response('metadata', 9, $bytes);
    ok((ref $r eq 'HASH') && @{$r->{brokers}} == 1
        && $r->{brokers}[0]{host} eq 'host1',
        'template metadata v9 parses to expected structure');
}
{
    my ($bytes) = tpl_produce_v7();
    my $r = EV::Kafka::_test_parse_response('produce', 7, $bytes);
    ok((ref $r eq 'HASH')
        && $r->{topics}[0]{partitions}[0]{base_offset} == 42,
        'template produce v7 parses to expected structure');
}
{
    my ($bytes) = tpl_fetch_v4();
    my $r = EV::Kafka::_test_parse_response('fetch', 4, $bytes);
    my $recs = (ref $r eq 'HASH') ? $r->{topics}[0]{partitions}[0]{records} : undef;
    ok((ref $recs eq 'ARRAY') && @$recs == 1 && $recs->[0]{key} eq 'k',
        'template fetch v4 parses, record batch decoded');
}
{
    my ($bytes) = tpl_fetch_v7();
    my $r = EV::Kafka::_test_parse_response('fetch', 7, $bytes);
    my $recs = (ref $r eq 'HASH') ? $r->{topics}[0]{partitions}[0]{records} : undef;
    ok((ref $recs eq 'ARRAY') && @$recs == 1 && $recs->[0]{value} eq 'v',
        'template fetch v7 parses, record batch decoded');
}
{
    my ($bytes) = tpl_list_offsets_v1();
    my $r = EV::Kafka::_test_parse_response('list_offsets', 1, $bytes);
    ok((ref $r eq 'HASH')
        && $r->{topics}[0]{partitions}[0]{offset} == 7,
        'template list_offsets v1 parses to expected structure');
}
{
    my ($bytes) = tpl_batch();
    my $r = EV::Kafka::_test_decode_batch($bytes);
    ok((ref $r eq 'ARRAY') && @$r == 1 && $r->[0]{key} eq 'k',
        'template record batch decodes');
}

# --- Phase 1: deterministic hostile-field matrix, response parsers --------
($checked, $bad) = (0, 0);
for my $tpl (@TPL) {
    my ($name, $api, $ver, $build) = @$tpl;
    my ($bytes, $sites) = $build->();
    for my $site (@$sites) {
        my ($off, $kind) = @$site;
        my @values = $kind eq 'i32' ? hostile_i32(length $bytes, $off)
                   : $kind eq 'i16' ? hostile_i16(length $bytes, $off)
                   : @HOSTILE_UVAR;
        for my $v (@values) {
            run_parse("$name site\@$off", $api, $ver,
                      mutate_at($bytes, $site, $v));
        }
    }
}
ok(!$bad, "phase 1: $checked deterministic hostile-field response parses survived");

# --- Phase 2: deterministic hostile-field matrix, record-batch decoder ----
($checked, $bad) = (0, 0);
{
    my ($bytes, $sites) = tpl_batch();
    for my $site (@$sites) {
        my ($off, $kind, $width, $crc, $fname) = @$site;
        my @values = $kind eq 'i32' ? hostile_i32(length $bytes, $off)
                   : @HOSTILE_UVAR;
        for my $v (@values) {
            my $mut = mutate_at($bytes, $site, $v);
            $mut = fix_crc($mut) if $crc;
            run_batch("batch $fname\@$off", $mut);
        }
    }
}
ok(!$bad, "phase 2: $checked deterministic hostile-field batch decodes survived");

# --- Phase 3: random structured mutations, response envelopes -------------
($checked, $bad) = (0, 0);
srand 42;
for my $i (1 .. $iters) {
    my $tpl = $TPL[int(rand(scalar @TPL))];
    my ($name, $api, $ver, $build) = @$tpl;
    my ($bytes, $sites) = $build->();
    for (1 .. 1 + int(rand(3))) {
        my $site = $sites->[int(rand(scalar @$sites))];
        my ($off, $kind) = @$site;