1#!./perl
2#
3# Execute the various code snippets in t/perf/benchmarks
4# to ensure that they are all syntactically correct
5
6BEGIN {
7    chdir 't';
8    require './test.pl';
9    @INC = ('.', '../lib');
10}
11
12use warnings;
13use strict;
14
15
16my $file = 'perf/benchmarks';
17my $benchmark_array = do $file;
18unless ($benchmark_array) {
19    die "Error while parsing '$file': $@\n" if $@;
20    die "Error while trying to read '$file': $!"
21        unless defined $benchmark_array;
22    die "Unknown error running '$file'\n";
23}
24
25die "'$file' did not return an array ref\n"
26        unless ref $benchmark_array eq 'ARRAY';
27
28die "Not an even number of key value pairs in '$file'\n"
29        if @$benchmark_array % 2;
30
31my %benchmarks;
32while (@$benchmark_array) {
33    my $key  = shift @$benchmark_array;
34    my $hash = shift @$benchmark_array;
35    die "Duplicate key '$key' in '$file'\n" if exists $benchmarks{$key};
36    $benchmarks{$key} = $hash;
37}
38
39plan keys(%benchmarks) * 4;
40
41# check the hash of hashes is minimally consistent in format
42
43my %valid_keys = map { $_=> 1 } qw(desc setup code pre post compile);
44my @required_keys = qw(code);
45
46for my $token (sort keys %benchmarks) {
47    like($token, qr/^[a-zA-Z](\w|::)+$/a, "$token: legal token");
48
49    my @keys    = sort keys %{$benchmarks{$token}};
50    my @invalid = grep !exists $valid_keys{$_}, @keys;
51    ok(!@invalid, "$token: only valid keys present")
52        or diag("saw these invalid keys: (@invalid)");
53
54    my @missing = grep !exists $benchmarks{$token}{$_}, @required_keys;
55    ok(!@missing, "$token: all required keys present")
56        or diag("these keys are missing: (@missing)");
57}
58
59# check that each bit of code compiles and runs
60
61for my $token (sort keys %benchmarks) {
62    my $b = $benchmarks{$token};
63    my $setup = $b->{setup} // '';
64    my $pre   = $b->{pre}   // '';
65    my $post  = $b->{post}  // '';
66    my $code = "package $token; $setup; for (1..1) { $pre; $b->{code}; $post; } 1;";
67    no warnings;
68    no strict;
69    ok(eval $code, "running $token")
70        or do {
71            diag("code:");
72            diag($code);
73            diag("gave:");
74            diag($@);
75        }
76}
77
78
79