This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
bench.pl: add checks for bad benchmark files
authorDavid Mitchell <davem@iabyn.com>
Sat, 21 Oct 2017 14:53:05 +0000 (15:53 +0100)
committerDavid Mitchell <davem@iabyn.com>
Mon, 23 Oct 2017 10:52:02 +0000 (11:52 +0100)
When reading in a --benchmark file, do some basic sanity checks on the
values read in:
    * an even number of name => {} pairs
    * a valid test name
    * valid hash keys

MANIFEST
Porting/bench.pl
t/porting/bench.t
t/porting/bench/badhash [new file with mode: 0644]
t/porting/bench/badname [new file with mode: 0644]
t/porting/bench/oddentry [new file with mode: 0644]

index 912907a..b320703 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5806,9 +5806,12 @@ t/perl.supp                      Perl valgrind suppressions
 t/porting/args_assert.t                Check that all PERL_ARGS_ASSERT* macros are used
 t/porting/authors.t            Check that all authors have been acknowledged
 t/porting/bench.t              Check Porting/bench.pl runs ok
+t/porting/bench/badhash                a test file for t/porting/bench.t
+t/porting/bench/badname                a test file for t/porting/bench.t
 t/porting/bench/badversion.json        a test file for t/porting/bench.t
 t/porting/bench/callsub.json   a test file for t/porting/bench.t
 t/porting/bench/callsub2.json  a test file for t/porting/bench.t
+t/porting/bench/oddentry       a test file for t/porting/bench.t
 t/porting/bench/ret0           a test file for t/porting/bench.t
 t/porting/bench/synerr         a test file for t/porting/bench.t
 t/porting/bench_selftest.t     run Porting/bench.pl's selftest facility
index 55c1786..d6f0da5 100755 (executable)
@@ -616,6 +616,29 @@ sub read_tests_file {
         die "Error: can't read '$file': $!\n";
     }
 
+    # validate and process each test
+
+    {
+        my %valid = map { $_ => 1 } qw(desc setup code);
+        my @tests = @$ta;
+        if (!@tests || @tests % 2 != 0) {
+            die "Error: '$file' does not contain evenly paired test names and hashes\n";
+        }
+        while (@tests) {
+            my $name = shift @tests;
+            my $hash = shift @tests;
+
+            unless ($name =~ /^[a-zA-Z]\w*(::\w+)*$/) {
+                die "Error: '$file': invalid test name: '$name'\n";
+            }
+
+            for (sort keys %$hash) {
+                die "Error: '$file': invalid key '$_' for test '$name'\n"
+                    unless exists $valid{$_};
+            }
+        }
+    }
+
     my @orig_order;
     for (my $i=0; $i < @$ta; $i += 2) {
         push @orig_order, $ta->[$i];
index 73d19c2..ee4c1c3 100644 (file)
@@ -169,6 +169,21 @@ for my $test (
         "croak: --benchfile which returns 0"
     ],
     [
+        "--benchfile=t/porting/bench/oddentry perl",
+        qr{\AError: 't/porting/bench/oddentry' does not contain evenly paired test names and hashes\n},
+        "croak: --benchfile with odd number of entries"
+    ],
+    [
+        "--benchfile=t/porting/bench/badname perl",
+        qr{\AError: 't/porting/bench/badname': invalid test name: '1='\n},
+        "croak: --benchfile with invalid test name"
+    ],
+    [
+        "--benchfile=t/porting/bench/badhash perl",
+        qr{\AError: 't/porting/bench/badhash': invalid key 'blah' for test 'foo::bar'\n},
+        "croak: --benchfile with invalid test hash key"
+    ],
+    [
         "--norm=2 ./miniperl ./perl",
         "Error: --norm value 2 outside range 0..1\n",
         "croak: select-a-perl out of range"
diff --git a/t/porting/bench/badhash b/t/porting/bench/badhash
new file mode 100644 (file)
index 0000000..38dd473
--- /dev/null
@@ -0,0 +1,15 @@
+#!perl
+# for the use of t/porting/bench.pl.
+#
+# A file to load which has an invalid hash key
+
+
+[ 
+    'foo::bar' => {
+        desc    => 'my $x = "abc"',
+        setup   => '',
+        code    => 'my $x = "abc"',
+        blah    => 1,
+    },
+];
+
diff --git a/t/porting/bench/badname b/t/porting/bench/badname
new file mode 100644 (file)
index 0000000..f3de2d8
--- /dev/null
@@ -0,0 +1,14 @@
+#!perl
+# for the use of t/porting/bench.pl.
+#
+# A file to load which has an invalid test name
+
+
+[ 
+    '1=' => {
+        desc    => 'my $x = "abc"',
+        setup   => '',
+        code    => 'my $x = "abc"',
+    },
+];
+
diff --git a/t/porting/bench/oddentry b/t/porting/bench/oddentry
new file mode 100644 (file)
index 0000000..baca03a
--- /dev/null
@@ -0,0 +1,10 @@
+#!perl
+# for the use of t/porting/bench.pl.
+#
+# A file to load which has an odd number of test/hash pairs
+
+
+[ 
+    'foo::bar',
+];
+