1 files changed, 100 insertions, 0 deletions
diff --git a/gnu/usr.bin/perl/cpan/IPC-SysV/t/sem.t b/gnu/usr.bin/perl/cpan/IPC-SysV/t/sem.t
new file mode 100755
index 00000000000..60fd039843e
--- /dev/null
+++ b/gnu/usr.bin/perl/cpan/IPC-SysV/t/sem.t
@@ -0,0 +1,100 @@
+################################################################################
+#
+#  $Revision: 15 $
+#  $Author: mhx $
+#  $Date: 2008/11/28 18:08:11 +0100 $
+#
+################################################################################
+#
+#  Version 2.x, Copyright (C) 2007, Marcus Holland-Moritz <mhx@cpan.org>.
+#  Version 1.x, Copyright (C) 1999, Graham Barr <gbarr@pobox.com>.
+#
+#  This program is free software; you can redistribute it and/or
+#  modify it under the same terms as Perl itself.
+#
+################################################################################
+
+BEGIN {
+  if ($ENV{'PERL_CORE'}) {
+    chdir 't' if -d 't';
+    @INC = '../lib' if -d '../lib' && -d '../ext';
+  }
+
+  require Test::More; import Test::More;
+  require Config; import Config;
+
+  if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
+    plan(skip_all => 'IPC::SysV was not built');
+  }
+}
+
+if ($Config{'d_sem'} ne 'define') {
+  plan(skip_all => '$Config{d_sem} undefined');
+}
+elsif ($Config{'d_msg'} ne 'define') {
+  plan(skip_all => '$Config{d_msg} undefined');
+}
+
+use IPC::SysV qw(
+	SETALL
+	IPC_PRIVATE
+	IPC_CREAT
+	IPC_RMID
+	IPC_NOWAIT
+	IPC_STAT
+	S_IRWXU
+	S_IRWXG
+	S_IRWXO
+);
+use IPC::Semaphore;
+
+# FreeBSD's default limit seems to be 9
+my $nsem = 5;
+my $sem = sub {
+  my $code = shift;
+  if (exists $SIG{SYS}) {
+    local $SIG{SYS} = sub { plan(skip_all => "SIGSYS caught") };
+    return $code->();
+  }
+  return $code->();
+}->(sub { IPC::Semaphore->new(IPC_PRIVATE, $nsem, S_IRWXU | S_IRWXG | S_IRWXO | IPC_CREAT) });
+
+unless (defined $sem) {
+  my $info = "IPC::Semaphore->new failed: $!";
+  if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS ||
+      $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) {
+    plan(skip_all => $info);
+  }
+  else {
+    die $info;
+  }
+}
+
+plan(tests => 11);
+
+pass('acquired a semaphore');
+
+ok(my $st = $sem->stat,'stat it');
+
+ok($sem->setall((0) x $nsem), 'set all');
+
+my @sem = $sem->getall;
+cmp_ok(join("", @sem), 'eq', "00000", 'get all');
+
+$sem[2] = 1;
+ok($sem->setall(@sem), 'set after change');
+
+@sem = $sem->getall;
+cmp_ok(join("", @sem), 'eq', "00100", 'get again');
+
+my $ncnt = $sem->getncnt(0);
+ok(!$sem->getncnt(0), 'procs waiting now');
+ok(defined($ncnt), 'prev procs waiting');
+
+ok($sem->op(2, -1, IPC_NOWAIT), 'op nowait');
+
+ok(!$sem->getncnt(0), 'no procs waiting');
+
+END {
+  ok($sem->remove, 'remove semaphore') if defined $sem;
+}