The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl -w

use strict;
use warnings;
use diagnostics;

use Test::More;
use Test::Warn;
use CHI;
use IPC::SysV qw(S_IRUSR S_IWUSR);
use IPC::SharedMem;

BEGIN {
    use_ok( 'CHI::Driver::SharedMem' ) || print "Bail out!
";
}

NEW: {
	my $shm;
	my $SIGSYS_count = 0;
	eval {
		local $SIG{SYS} = sub { $SIGSYS_count++ };
		$shm = IPC::SharedMem->new(1, 8 * 1024, S_IRUSR|S_IWUSR);
	};
	if($@ || $SIGSYS_count) {
		if($^O eq 'cygwin') {
			diag("It may be that the cygserver service isn't running.");
		}
	} else {
		ok(!defined($shm), 'Shared memory area does not exist before the test');
		{
			my $cache = CHI->new(driver => 'SharedMem', shmkey => 1);
			ok(defined($cache));

			# Calling get_namespaces() will force the area to be created
			my @a = $cache->get_namespaces();
			ok((scalar(@a) == 0), 'The cache is empty');

			$shm = IPC::SharedMem->new(1, 8 * 1024, S_IRUSR|S_IWUSR);
			ok(defined($shm), 'Shared memory exists during the test');

			# diag('Ignore no key given message');
			# warning_like
				# { $cache = CHI->new(driver => 'SharedMem') }
				# { carped => qr/CHI::Driver::SharedMem - no key given/ };

			eval {
				$cache = CHI->new(driver => 'SharedMem');
			};
			if($@) {
				ok($@ =~ /CHI::Driver::SharedMem - no key given/);
			} else {
				ok(0, 'Allowed shmkey to be undefined');
			}
		}

		$shm = IPC::SharedMem->new(1, 8 * 1024, S_IRUSR|S_IWUSR);
		ok(!defined($shm), 'Shared memory area does not exist after the test');
	}
	done_testing();
}