The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)

BEGIN { $| = 1; print "1..16\n"; }
END {print "not ok 1\n" unless $loaded;}

#use diagnostics;
use Socket;
use Net::NBsocket qw(
	open_udpNB
	dyn_bind
);

$loaded = 1;
print "ok 1\n";
######################### End of black magic.

# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):

$test = 2;

sub ok {
  print "ok $test\n";
  ++$test;
}

################################################################
################################################################

## test 2	test sock open

my ($buf,$rin,$rout,$win,$wout,$bytes);
my $sock = open_udpNB();
print "could not open socket\nnot "
	unless $sock;
&ok;

## test 3	test bind
my $port = dyn_bind($sock,&INADDR_LOOPBACK);
print "could not bind socket to port\nnot "
	unless $port;
&ok;

## test 4 - 15
my $saddr = sockaddr_in($port,&INADDR_LOOPBACK);
my $pid = fork;

die "could not fork\nnot " unless defined $pid;

$| = 1;

if ($pid) {			# parent
  close $sock;			# close server
  sleep 2;
  $sock = open_udpNB();
  my @lines = split(/\n/,q|The quick brown fox
jumped over the lazy dog
1234567890
tHE QUICK BROWN FOX JUMPED OVER THE LAZY DOG
|);
  foreach(@lines) {
    $rin = '';
    vec($rin,fileno($sock),1) = 1;
    $win = $rin;
    eval {
	local $SIG{ALRM} = sub {die "parent timed out";};
	alarm 2;
	select(undef,$wout=$win,undef,undef);	# block here
	$bytes = send($sock,$_,0,$saddr);
	select($rout=$rin,undef,undef,undef);	# block here
	recv($sock,$buf,1000,0);
	alarm 0;
    };
## test 4,7,10,13
    if ($@) {
      close $sock if $sock;
      print "Bail out! socket error: $@\nnot ";
    }
    &ok;
## test 5,8,11,14
    print "got: ". length($buf) .", exp: ". length($_) ." lines\nnot "
	unless length($buf) == length($_);
    &ok;
## test 6,9,12,15
    print "got: $buf, exp: $_\nnot "
	unless $buf eq $_;
    &ok;
  }
  sleep 2;
  close $sock;

} else {			# child

  local $SIG{ALRM} = sub {
	close $sock;
	exit 0;
  };
  local $SIG{INT} = sub {
#	print "CAUGHT 'INT'\n";
	close $sock;
	exit 0;
  };
  alarm 10;
  while (1) {
    $rin = '';
    vec($rin,fileno($sock),1) = 1;
    $win = $rin;
    my $nfound =  select($rout=$rin,undef,undef,undef);
    $saddr = recv($sock,$buf,1000,0);
    my $len = length($buf);
    select(undef,$wout=$win,undef,undef);
    $bytes = send($sock,$buf,0,$saddr);
  }
}

# print "$$ waiting for $pid\n";
kill 'INT', $pid;
eval {
# print "waiting...\n";
	local $SIG{ALRM} = sub {die "timed out";};
	alarm 10;
	waitpid($pid,0);
	alarm 0;
};

## test 16
print "waitpid $@\nnot "
	if $@;
&ok;