Ancient

 view release on metacpan or  search on metacpan

t/2024-doubly-fork.t  view on Meta::CPAN

        is($list->length, 3, 'parent still has 3 items (not affected by child)');
        
        # Parent can still modify its own list
        $list->add(10);
        is($list->length, 4, 'parent can add to its list');
    }
};

# Test 2: Multiple forks
subtest 'Multiple forks' => sub {
    plan tests => 3;

    my $list = doubly->new();
    $list->add("parent_item");
    
    my @pids;
    for my $i (1..4) {
        my $pid = fork();
        if ($pid == 0) {
            # Child process
            $list->add("child_${i}_item");
            exit($list->length == 2 ? 0 : 1);
        }
        push @pids, $pid;
    }
    
    # Wait for all children
    my $all_ok = 1;
    for my $pid (@pids) {
        waitpid($pid, 0);
        $all_ok = 0 if ($? >> 8) != 0;
    }
    
    ok($all_ok, 'all children completed successfully');
    is($list->length, 1, 'parent still has only 1 item');
    
    # Add more in parent
    $list->add("parent_item_2");
    $list->add("parent_item_3");
    is($list->length, 3, 'parent can continue adding');
};

# Test 3: Fork after complex operations
subtest 'Fork after complex operations' => sub {
    plan tests => 3;

    my $list = doubly->new(100);
    
    # Do some operations
    for my $i (1..10) {
        $list->add($i);
    }
    $list->remove_from_start;
    $list->remove_from_end;
    
    is($list->length, 9, 'list has 9 items');
    
    my $pid = fork();
    
    if ($pid == 0) {
        # Child - verify copy is intact
        my $len = $list->length;
        
        # Do more operations in child
        $list->add(999);
        $list->remove_from_start;
        
        exit($list->length == 9 ? 0 : 1);
    } else {
        waitpid($pid, 0);
        my $status = $? >> 8;
        
        is($status, 0, 'child operations succeeded');
        is($list->length, 9, 'parent list unchanged');
    }
};

# Test 4: Destroy in child doesn't affect parent
subtest 'Destroy in child is independent' => sub {
    plan tests => 3;

    my $list = doubly->new();
    $list->add(1);
    $list->add(2);
    $list->add(3);
    
    my $pid = fork();
    
    if ($pid == 0) {
        # Child destroys its copy
        $list->destroy;
        exit(0);
    } else {
        waitpid($pid, 0);
        my $status = $? >> 8;
        
        is($status, 0, 'child completed');
        is($list->length, 3, 'parent list still has 3 items');
        
        $list->start;
        is($list->data, 1, 'parent data still accessible');
    }
};

# Test 6: Heavy fork stress test
subtest 'Fork stress test' => sub {
    plan tests => 1;

    my $list = doubly->new();
    for my $i (1..50) {
        $list->add($i);
    }
    
    my @pids;
    for my $round (1..10) {
        my $pid = fork();
        if ($pid == 0) {
            # Child does some work
            for my $j (1..10) {
                $list->add($j + 100);
                $list->remove_from_start;



( run in 2.963 seconds using v1.01-cache-2.11-cpan-13bb782fe5a )