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