This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Don't use a fixed iteration count in dist/threads-shared/t/stress.t
authorNicholas Clark <nick@ccl4.org>
Mon, 3 Dec 2012 20:12:33 +0000 (21:12 +0100)
committerNicholas Clark <nick@ccl4.org>
Fri, 11 Jan 2013 10:21:31 +0000 (11:21 +0100)
Looping 500,000 times takes between 0.025s and 1s depending on hardware and
optimisation levels on machines I have access to. For a fixed iteration
count, on a particularly slow machine the timeout can fire before all
threads have had a realistic chance to complete, but dropping the iteration
count will cause fast machines to finish each thread too quickly.

So use an initial busy loop (single-thread) to estimate a suitable iteration
count to use for the per-thread test loop.

dist/threads-shared/t/stress.t

index e126a21..1dd95e3 100644 (file)
@@ -42,6 +42,47 @@ use threads::shared;
 {
     my $cnt = 50;
 
+    # Depending on hardware and compiler options, the time for a busy loop can
+    # by a factor of (at least) 40, so one size doesn't fit all.
+    # For a fixed iteration count, on a particularly slow machine the timeout
+    # can fire before all threads have had a realistic chance to complete, but
+    # dropping the iteration count will cause fast machines to finish each
+    # thread too quickly.
+    # Fastest machine I tested can loop 20,000,000 times a second, slowest
+    # 500,000
+
+    my $busycount;
+    {
+        my $tries = 1e4;
+        # Try to align to the start of a second:
+        my $want = time + 1;
+        while (time < $want && --$tries) {
+            my $sum;
+            for (0..1e4) {
+                ++$sum;
+            }
+        }
+
+        if ($tries) {
+            $tries = 1e4;
+            ++$want;
+
+            while (time < $want && --$tries) {
+                my $sum;
+                for (0..1e4) {
+                    ++$sum;
+                }
+            }
+
+            # This should be about 0.025s
+            $busycount = (1e4 - $tries) * 250;
+        } else {
+            # Fall back to the old default if everything fails
+            $busycount = 500000;
+        }
+        print "# Looping for $busycount iterations should take about 0.025s\n";
+    }
+
     my $TIMEOUT = 60;
 
     my $mutex = 1;
@@ -60,7 +101,7 @@ use threads::shared;
 
                             # Randomize the amount of work the thread does
                             my $sum;
-                            for (0..(500000+int(rand(500000)))) {
+                            for (0..($busycount+int(rand($busycount)))) {
                                 $sum++
                             }