This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
forcibly check the timing of the regex/alarm test in bulk
authorChristian Walde (Mithaldu) <walde.christian@gmail.com>
Mon, 29 Jun 2020 04:59:00 +0000 (06:59 +0200)
committerKarl Williamson <khw@cpan.org>
Sat, 3 Oct 2020 18:30:32 +0000 (12:30 -0600)
As per github #18129, github test VMs occasionally fail this alarm test.

This commit implements a loop that forces those systems to always fail the
test.

On cygwin running directly on iron this doesn't fail even after 1000
iterations.

However in order to make github smokes a little more useful for now, this
also marks it TODO.

t/re/pat.t

index c608df5..b01c7d1 100644 (file)
@@ -1902,14 +1902,31 @@ EOP
             }
         }
         {
-            fresh_perl_is('
+            my $is_cygwin = $^O eq "cygwin";
+            local $::TODO = "this flaps on github cygwin vm, but not on cygwin iron #18129"
+              if $is_cygwin;
+            my $expected = "Timeout";
+            my $code = '
                 BEGIN{require q(test.pl);}
                 watchdog(3);
-                $SIG{ALRM} = sub {print "Timeout\n"; exit(1)};
+                $SIG{ALRM} = sub {print "'.$expected.'\n"; exit(1)};
                 alarm 1;
                 $_ = "a" x 1000 . "b" x 1000 . "c" x 1000;
                 /.*a.*b.*c.*[de]/;
-            ',"Timeout",{},"Test Perl 73464")
+                print "increase the multipliers in the regex above to run the regex longer";
+            ';
+            # this flaps on github cygwin vm, but not on cygwin iron #18129
+            # so on cygwin it's run for 50 seconds to see if it fails eventually
+            my $max = $is_cygwin ? 50 : 1;
+            my ($iter, $result, $status);
+            for my $i (1..$max) {
+                $iter = $i;
+                $result = fresh_perl($code,{});
+                $status = $?;
+                last if $result ne $expected;
+            }
+            is($result, $expected, "Test Perl 73464")
+              or diag "PROG:", $code, "STATUS:", $status, "failed on iteration: $iter";
         }
 
         {   # [perl #128686], crashed the the interpreter