git.maemo.org Git - pkg-perl/blob - deb-src/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/readline.t

   1 #!perl -w
   2 # Before `make install' is performed this script should be runnable with
   3 # `make test'. After `make install' it should work as `perl t/readline.t'
   4
   5 # This tests the behavior of readline with the variety of
   6 # cases with $/:
   7 # $/ undef - read all
   8 # $/ ''    - read up to next nonempty line: .*?\n\n+
   9 # $/ s     - read up to string s
  10 # $/ \$num - read $num bytes
  11 # scalar context - get first match
  12 # array context  - get all matches
  13
  14 use Net::SSLeay;
  15 use Socket;
  16 use IO::Socket::SSL;
  17 use strict;
  18
  19 if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
  20     print "1..0 # Skipped: fork not implemented on this platform\n";
  21     exit
  22 }
  23
  24 my @tests;
  25 push @tests, [
  26     "multi\nple\n\n1234567890line\n\n\n\nbla\n\nblubb\n\nblip",
  27     sub {
  28         my $c = shift;
  29         local $/ = "\n\n";
  30         my $b;
  31         ($b=<$c>) eq "multi\nple\n\n" || die "LFLF failed ($b)";
  32         $/ = \"10";
  33         ($b=<$c>) eq "1234567890" || die "\\size failed ($b)";
  34         $/ = '';
  35         ($b=<$c>) eq "line\n\n\n\n" || die "'' failed ($b)";
  36         my @c = <$c>;
  37         die "'' @ failed: @c" unless $c[0] eq "bla\n\n" &&
  38             $c[1] eq "blubb\n\n" &&
  39             $c[2] eq "blip" && @c == 3;
  40     },
  41 ];
  42
  43 push @tests, [
  44     "some\nstring\nwith\nsome\nlines\nwhatever",
  45     sub {
  46         my $c = shift;
  47         local $/ = "\n";
  48         my $b;
  49         ($b=<$c>) eq "some\n" || die "LF failed ($b)";
  50         $/ = undef;
  51         ($b=<$c>) eq "string\nwith\nsome\nlines\nwhatever" || die "undef failed ($b)";
  52     },
  53 ];
  54
  55 push @tests, [
  56     "some\nstring\nwith\nsome\nlines\nwhatever",
  57     sub {
  58         my $c = shift;
  59         local $/ = "\n";
  60         my @c = <$c>;
  61         die "LF @ failed: @c" unless $c[0] eq "some\n" &&
  62             $c[1] eq "string\n" && $c[2] eq "with\n" && $c[3] eq "some\n" &&
  63             $c[4] eq "lines\n" && $c[5] eq "whatever" && @c == 6;
  64
  65     },
  66 ];
  67
  68 push @tests, [
  69     "some\nstring\nwith\nsome\nlines\nwhatever",
  70     sub {
  71         my $c = shift;
  72         local $/;
  73         my @c = <$c>;
  74         die "undef @ failed: @c" unless
  75             $c[0] eq "some\nstring\nwith\nsome\nlines\nwhatever"
  76             && @c == 1;
  77
  78     },
  79 ];
  80
  81 push @tests, [
  82     "1234567890",
  83     sub {
  84         my $c = shift;
  85         local $/ = \2;
  86         my @c = <$c>;
  87         die "\\2 @ failed: @c" unless
  88             $c[0] eq '12' && $c[1] eq '34' && $c[2] eq '56' &&
  89             $c[3] eq '78' && $c[4] eq '90' && @c == 5;
  90
  91     },
  92 ];
  93
  94 $|=1;
  95 print "1..".(1+3*@tests)."\n";
  96
  97
  98 # first create simple ssl-server
  99 my $ID = 'server';
 100 my $addr = '127.0.0.1';
 101 my $server = IO::Socket::SSL->new(
 102     LocalAddr => $addr,
 103     Listen => 2,
 104     ReuseAddr => 1,
 105     SSL_cert_file => "certs/server-cert.pem",
 106     SSL_key_file  => "certs/server-key.pem",
 107 ) || do {
 108     notok($!);
 109     exit
 110 };
 111 ok("Server Initialization");
 112
 113 # add server port to addr
 114 $addr.= ':'.(sockaddr_in( getsockname( $server )))[0];
 115
 116 my $pid = fork();
 117 if ( !defined $pid ) {
 118     die $!; # fork failed
 119
 120 } elsif ( $pid ) {    ###### Server
 121
 122     foreach my $test (@tests) {
 123         my $to_client = $server->accept || do {
 124             notok( "accept failed: ".$server->errstr() );
 125             kill(9,$pid);
 126             exit;
 127         };
 128         ok( "Server accepted" );
 129         $to_client->print($test->[0]);
 130     }
 131     wait;
 132     exit;
 133 }
 134
 135 $ID = 'client';
 136 close($server);
 137 my $testid = "Test00";
 138 foreach my $test (@tests) {
 139     my $to_server = IO::Socket::SSL->new( $addr ) || do {
 140         notok( "connect failed: ".IO::Socket::SSL->errstr() );
 141         exit
 142     };
 143     ok( "client connected" );
 144     eval { $test->[1]( $to_server ) };
 145     $@ ? notok( "$testid $@" ) : ok( $testid );
 146     $testid++
 147 }
 148
 149
 150
 151 sub ok { print "ok # [$ID] @_\n"; }
 152 sub notok { print "not ok # [$ID] @_\n"; }