]> granicus.if.org Git - fortune-mod/commitdiff
optimize tests suite using parallelising
authorShlomi Fish <shlomif@shlomifish.org>
Sat, 11 Dec 2021 11:04:22 +0000 (13:04 +0200)
committerShlomi Fish <shlomif@shlomifish.org>
Sat, 11 Dec 2021 11:04:22 +0000 (13:04 +0200)
.gitignore
fortune-mod/.tidyallrc
fortune-mod/run-tests.pl
fortune-mod/tests/data/valgrind.t [moved from fortune-mod/tests/t/valgrind.t with 97% similarity]
fortune-mod/tests/scripts/split-valgrind.pl [new file with mode: 0644]

index 15369acd9e969328b7a65b1201ff3274bf229f9f..bf9239fae2e6d906253d1ae0d110c97e74a037ac 100644 (file)
@@ -4,5 +4,6 @@
 /fortune-mod/fortune/fortune_with_offensive.template.man
 /fortune-mod/fortune/fortune_without_offensive.docbook5.xml
 /fortune-mod/fortune/fortune_without_offensive.template.man
+/fortune-mod/tests/t/valgrind0*.t
 /fortune-mod/util/randstr.man
 /fortune-mod/util/strfile.man
index 7bee1b643b1046f165f127bfe44205a8723380b7..f81db2b3cc7843a3c749f6c7dc0f5559450e4d3b 100644 (file)
@@ -3,7 +3,7 @@ select = **/*.{c,h}
 
 [PerlTidy]
 argv = -ci=4 -bl -cti=0 --character-encoding=none
-ignore = rinutils/run-tests.pl
+ignore = rinutils/run-tests.pl **/t/valgrind*.t
 select = **/*.{pl,pm,t}
 
 [PerlCritic]
index 09df303ded3ac64c0d11d746028033976a0f6744..43e1989abd27982dda322338db43ea2a43263efc 100644 (file)
@@ -35,6 +35,11 @@ sub do_system
     }
 }
 
+do_system(
+    {
+        cmd => [ $^X, "$src_dir/tests/scripts/split-valgrind.pl", ]
+    }
+);
 do_system(
     {
         cmd => [
similarity index 97%
rename from fortune-mod/tests/t/valgrind.t
rename to fortune-mod/tests/data/valgrind.t
index 17b9da060e734332f2d0125e64b85fe6d3c5992d..e392cbf151698ad80272e09819f341b34a918f01 100644 (file)
@@ -75,7 +75,7 @@ foreach my $prog (qw/ unstr /)
 {
     $obj->run(
         {
-            log_fn => "./fortune--$prog-buffer-overflow.valgrind-log",
+            log_fn => "./fortune--$prog-buffer-overflow--extended.valgrind-log",
             prog   => "./$prog",
             argv   => [
                 scalar( "AAAAAAAAAAAAAAAA/" x 1000 ),
diff --git a/fortune-mod/tests/scripts/split-valgrind.pl b/fortune-mod/tests/scripts/split-valgrind.pl
new file mode 100644 (file)
index 0000000..512e4bc
--- /dev/null
@@ -0,0 +1,71 @@
+#! /usr/bin/env perl
+#
+# Short description for split-valgrind.pl
+#
+# Version 0.0.1
+# Copyright (C) 2021 Shlomi Fish < https://www.shlomifish.org/ >
+#
+# Licensed under the terms of the MIT license.
+
+use strict;
+use warnings;
+use 5.014;
+use autodie;
+
+use Path::Tiny qw/ path tempdir tempfile cwd /;
+
+use FindBin;
+my $code = path("$FindBin::Bin/../data/valgrind.t")->slurp_utf8();
+
+# say $code;
+$code =~ s#\A(.*?^plan tests => [0-9]+;\n)##ms or die;
+my $start = $1;
+$start =~ s#^(plan tests => )[0-9]+#${1}1#ms or die;
+
+my $idx = 1;
+my $dir = path("$FindBin::Bin/../t");
+
+sub out
+{
+    my ($str) = @_;
+
+    $dir->child( sprintf( 'valgrind%04d.t', $idx++ ) )->spew_utf8(
+        $start,
+
+        q#my $obj = Test::RunValgrind->new( {} );#,
+        qq%\n# TEST\n%,
+        $str
+    );
+
+    return;
+}
+
+while ( $code =~ m#\G.*?^(foreach|\$obj->run)#gms )
+{
+    my $open = $1;
+    if ( $open eq "foreach" )
+    {
+        $code =~ m#\G my \$prog \(qw/([^/]+?)/\)\n\{.*?(^\s+\{.*?^\s+\})#gms
+            or die;
+        my ( $list, $params ) = ( $1, $2 );
+        foreach my $prog ( $list =~ /(\S+)/g )
+        {
+            out(
+                "        foreach my \$prog (qw/ $prog /) {
+
+    \$obj->run($params);}\n"
+            );
+        }
+    }
+    else
+    {
+        $code =~ m#\G.*?(^\s+\{.*?^\s+\})#gms
+            or die $code;
+        my ($params) = ($1);
+        foreach my $prog (1)
+        {
+            out( "
+    \$obj->run($params);\n" );
+        }
+    }
+}