summaryrefslogtreecommitdiff
path: root/gnu/usr.bin/perl/t/perf/benchmarks.t
blob: 57dbcf8793759b000450e698c9cf2c5d593c6d16 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
#!./perl
#
# Execute the various code snippets in t/perf/benchmarks
# to ensure that they are all syntactically correct

BEGIN {
    chdir 't';
    require './test.pl';
    @INC = ('.', '../lib');
}

use warnings;
use strict;


my $file = 'perf/benchmarks';
my $benchmark_array = do $file;
die $@ if $@;
die "$! while trying to read '$file'" if $!;
die "'$file' did not return an array ref\n"
        unless ref $benchmark_array eq 'ARRAY';

die "Not an even number of key value pairs in '$file'\n"
        if @$benchmark_array % 2;

my %benchmarks;
while (@$benchmark_array) {
    my $key  = shift @$benchmark_array;
    my $hash = shift @$benchmark_array;
    die "Duplicate key '$key' in '$file'\n" if exists $benchmarks{$key};
    $benchmarks{$key} = $hash;
}

plan keys(%benchmarks) * 4;

# check the hash of hashes is minimally consistent in format

my %valid_keys = map { $_=> 1 } qw(desc setup code pre post compile);
my @required_keys = qw(code);

for my $token (sort keys %benchmarks) {
    like($token, qr/^[a-zA-Z](\w|::)+$/a, "$token: legal token");

    my @keys    = sort keys %{$benchmarks{$token}};
    my @invalid = grep !exists $valid_keys{$_}, @keys;
    ok(!@invalid, "$token: only valid keys present")
        or diag("saw these invalid keys: (@invalid)");

    my @missing = grep !exists $benchmarks{$token}{$_}, @required_keys;
    ok(!@missing, "$token: all required keys present")
        or diag("these keys are missing: (@missing)");
}

# check that each bit of code compiles and runs

for my $token (sort keys %benchmarks) {
    my $b = $benchmarks{$token};
    my $setup = $b->{setup} // '';
    my $pre   = $b->{pre}   // '';
    my $post  = $b->{post}  // '';
    my $code = "package $token; $setup; for (1..1) { $pre; $b->{code}; $post; } 1;";
    no warnings;
    no strict;
    ok(eval $code, "running $token")
        or do {
            diag("code:");
            diag($code);
            diag("gave:");
            diag($@);
        }
}