Tests: t/003safesys.t parallelisiert
authorMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 10 Feb 2017 16:07:53 +0000 (17:07 +0100)
committerMoritz Bunkus <m.bunkus@linet-services.de>
Fri, 10 Feb 2017 16:20:02 +0000 (17:20 +0100)
t/003safesys.t

index b4f41f6..436fc7b 100644 (file)
@@ -1,22 +1,22 @@
 # -*- Mode: perl; indent-tabs-mode: nil -*-
-# 
+#
 # The contents of this file are subject to the Mozilla Public
 # License Version 1.1 (the "License"); you may not use this file
 # except in compliance with the License. You may obtain a copy of
 # the License at http://www.mozilla.org/MPL/
-# 
+#
 # Software distributed under the License is distributed on an "AS
 # IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 # implied. See the License for the specific language governing
 # rights and limitations under the License.
-# 
+#
 # The Original Code are the Bugzilla Tests.
-# 
+#
 # The Initial Developer of the Original Code is Zach Lipton
-# Portions created by Zach Lipton are 
+# Portions created by Zach Lipton are
 # Copyright (C) 2001 Zach Lipton.  All
 # Rights Reserved.
-# 
+#
 # Contributor(s): Zach Lipton <zach@zachlipton.com>
 
 
 ###Safesystem####
 
 use strict;
+use threads;
 
 use lib 't';
 
 use Support::Files;
+use Sys::CPU;
+use Thread::Pool::Simple;
 
 use Test::More tests => scalar(@Support::Files::testitems);
 
@@ -46,20 +49,34 @@ my $fh;
     }
 }
 
-my @testitems = @Support::Files::testitems; 
+my @testitems = @Support::Files::testitems;
 my $perlapp = "\"$^X\"";
 
+sub test_file {
+  my ($file)  = @_;
+  my $command = "$perlapp -c -It -MSupport::Systemexec $file 2>&1";
+  my $loginfo =`$command`;
+
+  if ($loginfo =~ /arguments for Support::Systemexec::(system|exec)/im) {
+    ok(0,"$file DOES NOT use proper system or exec calls");
+    print $fh $loginfo;
+  } else {
+    ok(1,"$file uses proper system and exec calls");
+  }
+}
+
+my $pool = Thread::Pool::Simple->new(
+  min    => 2,
+  max    => Sys::CPU::cpu_count() + 1,
+  do     => [ \&test_file ],
+  passid => 0,
+);
+
 foreach my $file (@testitems) {
-    $file =~ s/\s.*$//; # nuke everything after the first space (#comment)
-    next if (!$file); # skip null entries
-    my $command = "$perlapp -c -It -MSupport::Systemexec $file 2>&1";
-    my $loginfo=`$command`;
-    if ($loginfo =~ /arguments for Support::Systemexec::(system|exec)/im) {
-        ok(0,"$file DOES NOT use proper system or exec calls");
-        print $fh $loginfo;
-    } else {
-        ok(1,"$file uses proper system and exec calls");
-    }
+  $file =~ s/\s.*$//;           # nuke everything after the first space (#comment)
+  $pool->add($file) if $file;   # skip null entries
 }
 
+$pool->join;
+
 exit 0;