| Subject: | Sync test suite with bleadperl |
The libnet test suite is slightly out of sync with what is currently in bleadperl.
hostname.t is missing the following patch:
http://perl5.git.perl.org/perl.git/commit/adeb94125ab7de8d20c129a905a5159972ad9fd1
and time.t is missing entirely; it was added by the following patch, which synced blead with 1.0901-tobe:
http://perl5.git.perl.org/perl.git/commit/c85707204c5d2a93ef021c88e43a92ba2d602304
Please could you consider adding these patches to libnet and rolling a new CPAN to get things back in sync. The attached patch (against 1.22) does this.
If time.t has been intentionally removed then please can you let me know and I will remove it from blead too.
It would be very convenient if you were able to do this before 20th August when the next Perl release is made.
| Subject: | sync-with-blead.patch |
diff -ruN libnet-1.22.orig/t/hostname.t libnet-1.22/t/hostname.t
--- libnet-1.22.orig/t/hostname.t 2007-08-26 13:14:12.000000000 +0100
+++ libnet-1.22/t/hostname.t 2013-03-13 08:36:23.794364000 +0000
@@ -26,7 +26,10 @@
$domain = domainname();
if(defined $domain && $domain ne "") {
- print "ok 1\n";
+ print "ok 1 - defined, non-empty domainname\n";
+}
+elsif (not defined $domain) {
+ print "ok 1 # SKIP domain not fully defined\n";
}
else {
print "not ok 1\n";
diff -ruN libnet-1.22.orig/t/time.t libnet-1.22/t/time.t
--- libnet-1.22.orig/t/time.t 1970-01-01 00:00:00.000000000 +0000
+++ libnet-1.22/t/time.t 2013-03-13 08:36:23.804364000 +0000
@@ -0,0 +1,133 @@
+#!./perl -w
+
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ if (!eval "require Socket") {
+ print "1..0 # no Socket\n"; exit 0;
+ }
+ if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
+ print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
+ }
+ $INC{'IO/Socket.pm'} = 1;
+ $INC{'IO/Select.pm'} = 1;
+ $INC{'IO/Socket/INET.pm'} = 1;
+}
+
+(my $libnet_t = __FILE__) =~ s/time.t/libnet_t.pl/;
+require $libnet_t;
+
+print "1..12\n";
+# cannot use(), otherwise it will use IO::Socket and IO::Select
+eval{ require Net::Time; };
+ok( !$@, 'should be able to require() Net::Time safely' );
+ok( exists $INC{'Net/Time.pm'}, 'should be able to use Net::Time' );
+
+# force the socket to fail
+make_fail('IO::Socket::INET', 'new');
+my $badsock = Net::Time::_socket('foo', 1, 'bar', 'baz');
+is( $badsock, undef, '_socket() should fail if Socket creation fails' );
+
+# if socket is created with protocol UDP (default), it will send a newline
+my $sock = Net::Time::_socket('foo', 2, 'bar');
+ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
+is( $sock->{sent}, "\n", 'should send \n with UDP protocol set' );
+is( $sock->{timeout}, 120, 'timeout should default to 120' );
+
+# now try it with a custom timeout and a different protocol
+$sock = Net::Time::_socket('foo', 3, 'bar', 'tcp', 11);
+ok( $sock->isa('IO::Socket::INET'), 'should be an IO::Socket::INET object' );
+is( $sock->{sent}, undef, '_socket() should send nothing unless UDP protocol' );
+is( $sock->{PeerAddr}, 'bar', '_socket() should set PeerAddr in socket' );
+is( $sock->{timeout}, 11, '_socket() should respect custom timeout value' );
+
+# inet_daytime
+# check for correct args (daytime, 13)
+IO::Socket::INET::set_message('z');
+is( Net::Time::inet_daytime('bob'), 'z', 'inet_daytime() should receive data' );
+
+# magic numbers defined in Net::Time
+my $offset = $^O eq 'MacOS' ?
+ (4 * 31536000) : (70 * 31536000 + 17 * 86400);
+
+# check for correct args (time, 13)
+# pretend it is only six seconds since the offset, create a fake message
+# inet_time
+IO::Socket::INET::set_message(pack("N", $offset + 6));
+is( Net::Time::inet_time('foo'), 6,
+ 'inet_time() should calculate time since offset for time()' );
+
+
+my %fail;
+
+sub make_fail {
+ my ($pack, $func, $num) = @_;
+ $num = 1 unless defined $num;
+
+ $fail{$pack}{$func} = $num;
+}
+
+package IO::Socket::INET;
+
+$fail{'IO::Socket::INET'} = {
+ new => 0,
+ 'send' => 0,
+};
+
+sub new {
+ my $class = shift;
+ return if $fail{$class}{new} and $fail{$class}{new}--;
+ bless( { @_ }, $class );
+}
+
+sub send {
+ my $self = shift;
+ my $class = ref($self);
+ return if $fail{$class}{'send'} and $fail{$class}{'send'}--;
+ $self->{sent} .= shift;
+}
+
+my $msg;
+sub set_message {
+ if (ref($_[0])) {
+ $_[0]->{msg} = $_[1];
+ } else {
+ $msg = shift;
+ }
+}
+
+sub do_recv {
+ my ($len, $msg) = @_[1,2];
+ $_[0] .= substr($msg, 0, $len);
+}
+
+sub recv {
+ my ($self, $buf, $length, $flags) = @_;
+ my $message = exists $self->{msg} ?
+ $self->{msg} : $msg;
+
+ if (defined($message)) {
+ do_recv($_[1], $length, $message);
+ }
+ 1;
+}
+
+package IO::Select;
+
+sub new {
+ my $class = shift;
+ return if defined $fail{$class}{new} and $fail{$class}{new}--;
+ bless({sock => shift}, $class);
+}
+
+sub can_read {
+ my ($self, $timeout) = @_;
+ my $class = ref($self);
+ return if defined $fail{$class}{can_read} and $fail{class}{can_read}--;
+ $self->{sock}{timeout} = $timeout;
+ 1;
+}
+
+1;