summaryrefslogtreecommitdiff
path: root/Porting/bench.pl
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2017-10-21 15:53:05 +0100
committerDavid Mitchell <davem@iabyn.com>2017-10-23 11:52:02 +0100
commit1836b255cca8d49a9dc4d41951aadc0ba8f715f3 (patch)
tree0a6a54c541b6ec4d90f211e0536f533b4db70182 /Porting/bench.pl
parent8924d3981a915e9170e1e99e3370f2a47d9a371a (diff)
downloadperl-1836b255cca8d49a9dc4d41951aadc0ba8f715f3.tar.gz
bench.pl: add checks for bad benchmark files
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
Diffstat (limited to 'Porting/bench.pl')
-rwxr-xr-xPorting/bench.pl23
1 files changed, 23 insertions, 0 deletions
diff --git a/Porting/bench.pl b/Porting/bench.pl
index 55c1786d84..d6f0da5afa 100755
--- a/Porting/bench.pl
+++ b/Porting/bench.pl
@@ -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];