Testsuite: retire perl smartmatch use
[exim.git] / test / runtest
index 204e09e7623be6e4d59f58e665a7d99c6c322966..24f80d3a42f708a57921dd020d73034d2f97ef5d 100755 (executable)
@@ -18,7 +18,6 @@
 #use strict;
 use v5.10.1;
 use warnings;
 #use strict;
 use v5.10.1;
 use warnings;
-use if $^V >= v5.19.11, experimental => 'smartmatch';
 
 use Errno;
 use FileHandle;
 
 use Errno;
 use FileHandle;
@@ -856,7 +855,7 @@ RESET_AFTER_EXTRA_LINE_READ:
   s/(?:Can(?:no|')t assign requested address|Address not available)/Netwk addr not available/;
   s/Operation timed out/Connection timed out/;
   s/Address family not supported by protocol family/Network Error/;
   s/(?:Can(?:no|')t assign requested address|Address not available)/Netwk addr not available/;
   s/Operation timed out/Connection timed out/;
   s/Address family not supported by protocol family/Network Error/;
-  s/Network is unreachable/Network unreachable/;
+  s/Network(?: is)? unreachable/Network Error/;
   s/Invalid argument/Network Error/;
 
   s/\(\d+\): Network/(dd): Network/;
   s/Invalid argument/Network Error/;
 
   s/\(\d+\): Network/(dd): Network/;
@@ -1075,6 +1074,15 @@ RESET_AFTER_EXTRA_LINE_READ:
 
     # mailq times change with when the run is done, vs. static-source spoolfiles
     s/\s*\d*[hd](?=   317 [0-9A-Za-z\-]{23} <nobody\@test.ex>)/DDd/;
 
     # mailq times change with when the run is done, vs. static-source spoolfiles
     s/\s*\d*[hd](?=   317 [0-9A-Za-z\-]{23} <nobody\@test.ex>)/DDd/;
+
+    # Not all builds include EXPERIMENTAL_DSN_INFO (1 of 2)
+    if (/^X-Exim-Diagnostic:/)
+      {
+      while (<IN>) {
+       last if (/^$/ || !/^\s/);
+        }
+      goto RESET_AFTER_EXTRA_LINE_READ;
+      }
     }
 
   # ======== stderr ========
     }
 
   # ======== stderr ========
@@ -1631,6 +1639,15 @@ RESET_AFTER_EXTRA_LINE_READ:
       <IN>;
       <IN>;
       }
       <IN>;
       <IN>;
       }
+
+    # Not all builds include EXPERIMENTAL_DSN_INFO (2 of 2)
+    if (/^X-Exim-Diagnostic:/)
+      {
+      while (<IN>) {
+       last if (/^$/ || !/^\s/);
+        }
+      goto RESET_AFTER_EXTRA_LINE_READ;
+      }
     }
 
   # ======== All files other than stderr ========
     }
 
   # ======== All files other than stderr ========
@@ -2305,6 +2322,7 @@ system($cmd);
 # Arguments: the current test number
 #            reference to the subtest number, holding previous value
 #            reference to the expected return code value
 # Arguments: the current test number
 #            reference to the subtest number, holding previous value
 #            reference to the expected return code value
+#            reference to flag for not-expected return value
 #            reference to where to put the command name (for messages)
 #            auxiliary information returned from a previous run
 #
 #            reference to where to put the command name (for messages)
 #            auxiliary information returned from a previous run
 #
@@ -2320,17 +2338,18 @@ system($cmd);
 sub run_command{
 my($testno) = $_[0];
 my($subtestref) = $_[1];
 sub run_command{
 my($testno) = $_[0];
 my($subtestref) = $_[1];
-my($commandnameref) = $_[3];
-my($aux_info) = $_[4];
+my($commandnameref) = $_[4];
+my($aux_info) = $_[5];
 my($yield) = 1;
 
 our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
 
 my($yield) = 1;
 
 our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
 
-if (/^(\d+)\s*(?:([A-Z]+)=(\S+))?$/)                # Handle unusual return code
+if (/^(~)?(\d+)\s*(?:([A-Z]+)=(\S+))?$/)                # Handle unusual return code
   {
   {
-  my($r) = $_[2];
-  $$r = $1 << 8;
-  $ENV{$2} = $3 if (defined $2);
+  my($r, $rn) = ($_[2], $_[3]);
+  $$r = $2 << 8;
+  $$rn = 1 if (defined $1);
+  $ENV{$3} = $4 if (defined $3);
   $_ = <SCRIPT>;
   return 4 if !defined $_;       # Missing command
   $lineno++;
   $_ = <SCRIPT>;
   return 4 if !defined $_;       # Missing command
   $lineno++;
@@ -2637,6 +2656,12 @@ if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ ||
   run_system("$_ >>test-stdout 2>>test-stderr");
   return 1;
   }
   run_system("$_ >>test-stdout 2>>test-stderr");
   return 1;
   }
+if (/^cat2\s/)
+  {
+  s/^cat2/cat/;
+  run_system("$_ 2>&1 >test-stderr");
+  return 1;
+  }
 
 
 
 
 
 
@@ -3374,6 +3399,7 @@ GetOptions(
 print "Exim binary is `$parm_exim'\n" if defined $parm_exim;
 
 
 print "Exim binary is `$parm_exim'\n" if defined $parm_exim;
 
 
+my %wanted;
 my @wanted = sort numerically uniq
   @tests_wanted ? @tests_wanted : (),
   @range_wanted ? $range_wanted[0] .. $range_wanted[1] : (),
 my @wanted = sort numerically uniq
   @tests_wanted ? @tests_wanted : (),
   @range_wanted ? $range_wanted[0] .. $range_wanted[1] : (),
@@ -3382,6 +3408,7 @@ my @wanted = sort numerically uniq
           0+$ARGV[0]..0+$ARGV[1]    # add 0 to cope with test numbers starting with zero
         : ();
 @wanted = 1..TEST_TOP if not @wanted;
           0+$ARGV[0]..0+$ARGV[1]    # add 0 to cope with test numbers starting with zero
         : ();
 @wanted = 1..TEST_TOP if not @wanted;
+map { $wanted{sprintf("%04d",$_)}= $_; } @wanted;
 
 ##################################################
 #        Check for sudo access to root           #
 
 ##################################################
 #        Check for sudo access to root           #
@@ -4194,7 +4221,9 @@ DIR: for (my $i = 0; $i < @test_dirs; $i++)
   # We want the tests from this subdirectory, provided they are in the
   # range that was selected.
 
   # We want the tests from this subdirectory, provided they are in the
   # range that was selected.
 
-  @testlist = grep { $_ ~~ @wanted } grep { /^\d+(?:\.\d+)?$/ } map { basename $_ } glob "scripts/$testdir/*";
+  undef @testlist;
+  map { push @testlist, $_ if exists $wanted{$_} } grep { /^\d+(?:\.\d+)?$/ } map { basename $_ } glob "scripts/$testdir/*";
+
   tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!")
     if not @testlist;
 
   tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!")
     if not @testlist;
 
@@ -4580,8 +4609,8 @@ foreach $test (@test_list)
     # was run and not waited for (usually a daemon or server startup).
 
     my($commandname) = '';
     # was run and not waited for (usually a daemon or server startup).
 
     my($commandname) = '';
-    my($expectrc) = 0;
-    my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
+    my($expectrc, $expect_not) = (0, 0);
+    my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$expect_not, \$commandname, $TEST_STATE);
     my($cmdrc) = $?;
 
     if ($debug) {
     my($cmdrc) = $?;
 
     if ($debug) {
@@ -4619,12 +4648,15 @@ foreach $test (@test_list)
     # We ran and waited for a command. Check for the expected result unless
     # it died.
 
     # We ran and waited for a command. Check for the expected result unless
     # it died.
 
-    if ($cmdrc != $expectrc && !$sigpipehappened)
+    if (!$sigpipehappened && ($expect_not ? ($cmdrc == $expectrc) : ($cmdrc != $expectrc)))
       {
       printf("** Command $commandno (\"$commandname\", starting at line $subtest_startline)\n");
       if (($cmdrc & 0xff) == 0)
         {
       {
       printf("** Command $commandno (\"$commandname\", starting at line $subtest_startline)\n");
       if (($cmdrc & 0xff) == 0)
         {
-        printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256);
+       if ($expect_not)
+         { printf("** Return code %d (expected anything but that)", $cmdrc/256); }
+       else
+         { printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256); }
         }
       elsif (($cmdrc & 0xff00) == 0)
         { printf("** Killed by signal %d", $cmdrc & 255); }
         }
       elsif (($cmdrc & 0xff00) == 0)
         { printf("** Killed by signal %d", $cmdrc & 255); }