From 5dd33ebbb550440bb773b780efe02646f3c6b10a Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Tue, 31 Jan 2023 08:01:13 +0100
Subject: t/29a_upcopy.t - under parallel builds allow more time for test

Karl has reported that he has issues with t/29a_upcopy.t under parallel
builds. I can not see any file based race conditions, but I can see code using
alarm around a test I can easily imagine would be too short for a loaded box
running many tests in parallel. This patch allows the test to use 20 seconds
instead of 10 if TEST_JOBS or HARNESS_OPTIONS are defined in the environment.
Hopefully this fixes tests on Karls box.

In a previous commit Dave M raised this from 5 to 10 seconds, so lets double
it again and see if Karls errors go away.

In an abundance of caution I also adjusted the other two cases of using
alarm() in this file to use the same logic and produce similar style
error messages.
---
 dist/Tie-File/lib/Tie/File.pm   |  2 +-
 dist/Tie-File/t/24_cache_loop.t | 10 +++++-----
 dist/Tie-File/t/29_downcopy.t   |  6 ++++--
 dist/Tie-File/t/29a_upcopy.t    |  7 ++++---
 4 files changed, 14 insertions(+), 11 deletions(-)

(limited to 'dist/Tie-File')

diff --git a/dist/Tie-File/lib/Tie/File.pm b/dist/Tie-File/lib/Tie/File.pm
index 824789337b..13d4fa6839 100644
--- a/dist/Tie-File/lib/Tie/File.pm
+++ b/dist/Tie-File/lib/Tie/File.pm
@@ -11,7 +11,7 @@ use Fcntl 'O_CREAT', 'O_RDWR', 'LOCK_EX', 'LOCK_SH', 'O_WRONLY', 'O_RDONLY';
 sub O_ACCMODE () { O_RDONLY | O_RDWR | O_WRONLY }
 
 
-our $VERSION = "1.06";
+our $VERSION = "1.07";
 my $DEFAULT_MEMORY_SIZE = 1<<21;    # 2 megabytes
 my $DEFAULT_AUTODEFER_THRESHHOLD = 3; # 3 records
 my $DEFAULT_AUTODEFER_FILELEN_THRESHHOLD = 65536; # 16 disk blocksful
diff --git a/dist/Tie-File/t/24_cache_loop.t b/dist/Tie-File/t/24_cache_loop.t
index f45265d59b..5143720a94 100644
--- a/dist/Tie-File/t/24_cache_loop.t
+++ b/dist/Tie-File/t/24_cache_loop.t
@@ -44,8 +44,11 @@ $N++;
 #   will then try to flush the read cache---but the read cache is
 #   already empty, so you're stuck in an infinite loop.
 #
-# Five seconds should be plenty of time for it to complete if it works.
-alarm 5 unless $^P;
+# Ten seconds should be plenty of time for it to complete if it works
+# on an unloaded box. Using 20 under parallel builds seems prudent.
+my $alarm_time = $ENV{TEST_JOBS} || $ENV{HARNESS_OPTIONS} ? 20 : 10;
+local $SIG{ALRM} = sub { die "$0 Timeout after $alarm_time seconds at test 3\n" };
+alarm $alarm_time unless $^P;
 @a = "record0" .. "record9";
 print "ok 3\n";
 alarm 0;
@@ -55,6 +58,3 @@ END {
   untie @a;
   1 while unlink $file;
 }
-
-
-
diff --git a/dist/Tie-File/t/29_downcopy.t b/dist/Tie-File/t/29_downcopy.t
index 9fd175c69e..1fbc852821 100644
--- a/dist/Tie-File/t/29_downcopy.t
+++ b/dist/Tie-File/t/29_downcopy.t
@@ -274,13 +274,15 @@ sub try {
   }
 
   my $o = tie my @lines, 'Tie::File', $file or die $!;
+  # allocate more time when are running tests in parallel
+  my $alarm_time = $ENV{TEST_JOBS} || $ENV{HARNESS_OPTIONS} ? 20 : 10;
   local $SIG{ALRM} = sub { die "Alarm clock" };
-  my $a_retval = eval { alarm(5) unless $^P; $o->_downcopy($newdata, $pos, $len) };
+  my $a_retval = eval { alarm($alarm_time) unless $^P; $o->_downcopy($newdata, $pos, $len) };
   my $err = $@;
   undef $o; untie @lines; alarm(0);
   if ($err) {
     if ($err =~ /^Alarm clock/) {
-      print STDERR "# $0 Timeout at test $N\n";
+      print STDERR "# $0 Timeout after $alarm_time seconds at test $N\n";
       print "not ok $N\n"; $N++;
       print "not ok $N\n"; $N++;
       if (defined $len) {
diff --git a/dist/Tie-File/t/29a_upcopy.t b/dist/Tie-File/t/29a_upcopy.t
index 4e84a52055..1d10217573 100644
--- a/dist/Tie-File/t/29a_upcopy.t
+++ b/dist/Tie-File/t/29a_upcopy.t
@@ -130,13 +130,15 @@ sub try {
   }
 
   my $o = tie my @lines, 'Tie::File', $file or die $!;
+  # allocate more time for the test if we are running parallel tests
+  my $alarm_time = ($ENV{TEST_JOBS} || $ENV{HARNESS_OPTIONS}) ? 20 : 10;
   local $SIG{ALRM} = sub { die "Alarm clock" };
-  my $a_retval = eval { alarm(10) unless $^P; $o->_upcopy($src, $dst, $len) };
+  my $a_retval = eval { alarm($alarm_time) unless $^P; $o->_upcopy($src, $dst, $len) };
   my $err = $@;
   undef $o; untie @lines; alarm(0);
   if ($err) {
     if ($err =~ /^Alarm clock/) {
-      print STDERR "# $0 Timeout at test $N\n";
+      print STDERR "# $0 Timeout after $alarm_time seconds at test $N\n";
       print "not ok $N\n"; $N++;
       return;
     } else {
@@ -173,4 +175,3 @@ sub ctrlfix {
 END {
   1 while unlink $file;
 }
-
-- 
cgit v1.2.1