More DWIMminess for Class::Struct: calling the array or hash
[p5sagit/p5-mst-13.2.git] / t / lib / io_sock.t
index 4ac4e35..b752fd8 100755 (executable)
@@ -30,7 +30,12 @@ BEGIN {
 }
 
 $| = 1;
-print "1..14\n";
+print "1..20\n";
+
+eval {
+    $SIG{ALRM} = sub { die; };
+    alarm 120;
+};
 
 use IO::Socket;
 
@@ -203,3 +208,131 @@ print "ok 13\n";
 $server->blocking(0);
 print "not " if $server->blocking;
 print "ok 14\n";
+
+### TEST 15
+### Set up some data to be transfered between the server and
+### the client. We'll use own source code ...
+#
+local @data;
+if( !open( SRC, "< $0")) {
+    print "not ok 15 - $!";
+} else {
+    @data = <SRC>;
+    close( SRC);
+}
+print "ok 15\n";
+
+### TEST 16
+### Start the server
+#
+my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
+    print "not ";
+print "ok 16\n";
+die if( !defined( $listen));
+my $serverport = $listen->sockport;
+
+my $server_pid = fork();
+if( $server_pid) {
+
+    ### TEST 17 Client/Server establishment
+    #
+    print "ok 17\n";
+
+    ### TEST 18
+    ### Get data from the server using a single stream
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("send\n");
+
+       my @array = ();
+       while( <$sock>) {
+           push( @array, $_);
+       }
+
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( @array != @data);
+    } else {
+       print "not ";
+    }
+    print "ok 18\n";
+
+    ### TEST 19
+    ### Get data from the server using a stream, which is
+    ### interrupted by eof calls.
+    ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
+    ### did an getc followed by an ungetc in order to check for the streams
+    ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
+    ### a recv(2) call on the socket, while ungetc(3) put back a character
+    ### to an IO buffer, which never again was read.
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("send\n");
+
+       my @array = ();
+       while( !eof( $sock ) ){
+           while( <$sock>) {
+               push( @array, $_);
+               last;
+           }
+       }
+
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( @array != @data);
+    } else {
+       print "not ";
+    }
+    print "ok 19\n";
+
+    ### TEST 20
+    ### Stop the server
+    #
+    $sock = IO::Socket::INET->new("localhost:$serverport")
+         || IO::Socket::INET->new("127.0.0.1:$serverport");
+
+    if ($sock) {
+       $sock->print("done\n");
+       $sock->close;
+
+       print "not " if( 1 != kill 0, $server_pid);
+    } else {
+       print "not ";
+    }
+    print "ok 20\n";
+
+} elsif( defined( $server_pid)) {
+   
+    ### Child
+    #
+    SERVER_LOOP: while (1) {
+       last SERVER_LOOP unless $sock = $listen->accept;
+       while (<$sock>) {
+           last SERVER_LOOP if /^quit/;
+           last if /^done/;
+           if( /^send/) {
+               print $sock @data;
+               last;
+           }
+           print;
+       }
+       $sock = undef;
+    }
+    $listen->close;
+
+} else {
+
+    ### Fork failed
+    #
+    print "not ok 17\n";
+    die;
+}
+