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
CommitLineData
24fb648d
DM
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';
9e7973fa 17my $benchmark_array = do $file;
24fb648d
DM
18die $@ if $@;
19die "$! while trying to read '$file'" if $!;
9e7973fa
DM
20die "'$file' did not return an array ref\n"
21 unless ref $benchmark_array eq 'ARRAY';
22
23die "Not an even number of key value pairs in '$file'\n"
24 if @$benchmark_array % 2;
25
26my %benchmarks;
27while (@$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}
24fb648d 33
ed7dc8b7 34plan keys(%benchmarks) * 4;
24fb648d
DM
35
36# check the hash of hashes is minimally consistent in format
37
ed7dc8b7
DM
38my %valid_keys = map { $_=> 1 } qw(desc setup code pre post compile);
39my @required_keys = qw(code);
40
9e7973fa 41for my $token (sort keys %benchmarks) {
ed7dc8b7
DM
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)");
24fb648d
DM
52}
53
54# check that each bit of code compiles and runs
55
9e7973fa
DM
56for my $token (sort keys %benchmarks) {
57 my $b = $benchmarks{$token};
ed7dc8b7
DM
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;";
9e7973fa
DM
62 no warnings;
63 no strict;
24fb648d
DM
64 ok(eval $code, "running $token")
65 or do {
66 diag("code:");
67 diag($code);
68 diag("gave:");
69 diag($@);
70 }
71}
72
73