added basic ssl support to ircu
[ircu2.10.12-pk.git] / tests / test-driver.pl
index 64bc5bea7474e8f1c4a74451d2a694500544410a..8ba77a280cad873a0c4a557619421fa4e0af9a4e 100755 (executable)
@@ -58,6 +58,7 @@ POE::Session->create(inline_states =>
                       cmd_mode => \&cmd_generic,
                       cmd_nick => \&cmd_generic,
                       cmd_notice => \&cmd_message,
+                      cmd_oper => \&cmd_generic,
                       cmd_part => \&cmd_generic,
                       cmd_privmsg => \&cmd_message,
                       cmd_quit => \&cmd_generic,
@@ -163,7 +164,7 @@ sub drv_heartbeat {
 
     # expand any macros in the line
     $line =~ s/(?<=[^\\])%(\S+?)%/$heap->{macros}->{$1}
-      or die "Use of undefined macro $1 at $heap->{lineno}\n"/eg;
+      or die "Use of undefined macro $1 at line $heap->{lineno}\n"/eg;
     # remove any \-escapes
     $line =~ s/\\(.)/$1/g;
     # figure out the type of line
@@ -234,7 +235,7 @@ sub drv_heartbeat {
         my $client = $heap->{clients}->{$c};
         if (not $client) {
           print "ERROR: Unknown session name $c (line $heap->{lineno}; ignoring)\n";
-        } elsif (($used->{$c} and not $zero_time->{$cmd}) or not $client->{ready}) {
+        } elsif (($used->{$c} and not $zero_time->{$cmd}) or ($cmd ne 'expect' and not $client->{ready})) {
           push @unavail, $c;
         } else {
           push @avail, $c;
@@ -275,8 +276,8 @@ sub drv_heartbeat {
 }
 
 sub drv_timeout_expect {
-  my ($kernel, $session, $client) = @_[KERNEL, SESSION, ARG0];
-  print "ERROR: Dropping timed-out expectation by $client->{name}: ".join(',', @{$client->{expect}->[0]})."\n";
+  my ($kernel, $session, $client, $heap) = @_[KERNEL, SESSION, ARG0, HEAP];
+  print "\nERROR: Dropping timed-out expectation by $client->{name} (line $heap->{expect_lineno}): ".join(',', @{$client->{expect}->[0]})."\n";
   $client->{expect_alarms}->[0] = undef;
   unexpect($kernel, $session, $client);
 }
@@ -296,12 +297,12 @@ sub drv_default {
       my $expect = $client->{expect}->[0];
       my $mismatch;
       $args = $args->[2]; # ->[1] is the entire string, ->[2] is split
-      for (my $x=2; ($x<=$#$expect) and ($x<=$#$args) and not $mismatch; $x++) {
-        if ($args->[$x] !~ /$expect->[$x]/i) {
+      for (my $x=0; ($x+2<=$#$expect) and ($x<=$#$args) and not $mismatch; $x++) {
+        my $expectation = $expect->[$x+2];
+        if ($args->[$x] !~ /$expectation/i) {
           $mismatch = 1;
-          print "Mismatch in arg $x: $args->[$x] !~ $expect->[$x]\n";
+          print "Mismatch in arg $x: $args->[$x] !~ $expectation\n";
         }
-        # $mismatch = 1 unless $args->[$x] =~ /$expect->[$x]/i;
       }
       unexpect($kernel, $session, $client) unless $mismatch;
     }
@@ -369,6 +370,7 @@ sub cmd_wait {
 sub cmd_expect {
   my ($kernel, $session, $heap, $client, $args) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1];
   die "Missing argument" unless $#$args >= 0;
+  $heap->{expect_lineno} = $heap->{lineno};
   push @{$client->{expect}}, $args;
   push @{$client->{expect_alarms}}, $kernel->delay_set('timeout_expect', EXPECT_TIMEOUT, $client);
   $kernel->call($session, 'disable_client', $client);
@@ -390,22 +392,10 @@ sub check_expect {
   my $expected = $client->{expect}->[0];
 
   # check sender
-  if ($expected->[0] =~ /\*(.+)/) {
-    # we expect *sessionname, so look up session's current nick
-    my $exp = $1;
-    $sender =~ /^(.+)!/;
-    return 0 if lc($heap->{clients}->{$exp}->{nick}) ne lc($1);
-  } elsif ($expected->[0] =~ /^:?(.+!.+)/) {
-    # expect :nick!user@host, so compare whole thing
-    return 0 if lc($1) ne lc($sender);
-  } else {
-    # we only expect :nick, so compare that part
-    $sender =~ /^:?(.+)!/;
-    return 0 if lc($expected->[0]) ne lc($1);
-  }
+  return 0 unless $sender =~ /^:?\Q$expected->[0]\E/i;
 
   # compare text
-  return 0 if lc($text) !~ /$expected->[2]/i;
+  return 0 unless $text =~ /$expected->[2]/i;
 
   # drop expectation of event
   unexpect($kernel, $session, $client);