The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
package tlib;

use utf8;
use strict;
use warnings;
use Test::More;
our $skip_concurrency;
$tlib::skip_concurrency = 0;
sub test_backend {
    my $storage_name = shift;
    my @params = @_;
    my $be = $main::be;
    my $c = $be->new(
        {
            storage   => $storage_name->new( @params ),
            expires => 5,
            prefix  => 'test_2_queue'
        }
    );
    my $oldsize = $c->get_info->{size};
    $c->increment;
    is( $c->get_info(100)->{size}, $oldsize + 1, 'append/size' );
    $c->increment;
    my $info = $c->get_info(100);
    is( $info->{size}, $oldsize + 2, 'yet another' );
    cmp_ok( $info->{timeout}, '>=', 3, 'timeout' );
    sleep 3;
    $c->increment;
    sleep 3;
    is( $c->get_info->{size}, 1, 'expiring' );
    ok( $c->clear, 'clearing' );
SKIP: {
    skip 'Concurrency is not working', 1 if $tlib::skip_concurrency;
    foreach ( 1 .. 15 ) {
        if ( !fork ) {

            my $sub_cache = $be->new(
                {
                    storage   => $storage_name->new( @params ),
                    expires => 60,
                    prefix  => 'test_2_queue'
                }
            );
            foreach ( 1 .. 100 ) {
                $sub_cache->increment;
            }
            exit;
        }
    }
    1 while ( waitpid -1, 0 ) != -1;
    is( $c->get_info->{size}, 1500, 'concurrency' );
}
}

1;