fu/bench.PL

#!/usr/bin/perl

# Can be invoked as:
#   ./bench.PL          # generates FU/Benchmarks.pod, running new benchmarks as necessary
#   ./bench.PL id func  # invalidate cache for the (regex-)matching benchmark IDs and funcs and re-run them
#
# This script obviously has more dependencies than the FU distribution itself.
# It's supposed to be used by maintainers, not users.


# MakeMaker automatically runs this script as a default built step, but that's not very useful.
BEGIN { exit if @ARGV && @ARGV[0] eq 'bench'; }

use v5.36;
use builtin 'true', 'false';
use Benchmark ':hireswallclock', 'timethis';

my %modules = map +($_, eval "require $_; \$${_}::VERSION"), qw/
    FU
    Cpanel::JSON::XS
    JSON::PP
    JSON::XS
    JSON::SIMD
/;

my %data; # "id func modver" => { id func module modver rate exists }
{
    my $indata;
    if (open my $F, '<', 'FU/Benchmarks.pod') {
        while (<$F>) {
            chomp;
            $indata = 1 if /^# Cached data used by bench\.PL/;
            next if !$indata || !$_ || /^#/;
            my %d;
            @d{qw/id func module modver rate/} = split /\t/;
            $data{"$d{id} $d{func} $d{modver}"} = \%d;
        }
    }
}

if (@ARGV) {
    my $idre = qr/$ARGV[0]/i;
    my $funcre = $ARGV[1] ? qr/$ARGV[1]/i : qr/.*/;
    delete $_->{rate} for grep $_->{id} =~ /$idre/ && $_->{func} =~ /$funcre/, values %data;
}


my @bench; # [ id, text, [ func_1, funcmodule_1, funcsub_n, .. ] ]
sub def($id, $text, @f) {
    for my ($f, $m, $sub) (@f) {
        $m ||= $f;
        my $d = "$id $f $modules{$m}";
        $data{$d} ||= { id => $id, func => $f, module => $m, modver => $modules{$m} };
        $d = $data{$d};
        $d->{exists} = 1;
        if (!exists $d->{rate}) {
            my $o = timethis -1, $sub, 0, 'none';
            $d->{rate} = sprintf '%.0f', $o->iters/$o->real;
            printf "%-20s%-20s%10d/s\n", $d->{id}, $d->{func}, $d->{rate};
        }
    }
    push @bench, [ $id, $text, \@f ];
}




use FU::Util 'json_format';

sub jsonfmt($name, $text, $data) {
    # Use similar options for fair comparisons.
    my $cp = Cpanel::JSON::XS->new->allow_nonref->unblessed_bool->convert_blessed;
    my $pp = JSON::PP->new->allow_nonref->core_bools->convert_blessed;
    my $xs = JSON::XS->new->allow_nonref->boolean_values([false,true])->convert_blessed;
    my $si = JSON::SIMD->new->allow_nonref->core_bools->convert_blessed;
    my @opt = ();
    if ($name =~ /^canon/) {
        $cp = $cp->canonical;
        $pp = $pp->canonical;
        $xs = $xs->canonical;
        $si = $si->canonical;
        @opt = (canonical => 1);
    }
    def "jsonfmt/$name", $text,
        'JSON::PP',         undef, sub { $pp->encode($data) },
        'Cpanel::JSON::XS', undef, sub { $cp->encode($data) },
        'JSON::SIMD',       undef, sub { $si->encode($data) },
        'JSON::XS',         undef, sub { $xs->encode($data) },
        'FU::Util',         'FU',  sub { json_format $data, @opt };
}

# From JSON::XS POD.
jsonfmt api => 'API object from L<JSON::XS> documentation.',
    [ map +{method => 'handleMessage', params => ['user1','we were just talking'], 'id' => undef, 'array' => [1,11,234,-5,1e5,1e7,1,0]}, 1..10 ];

jsonfmt ints => 'Small integers', [ -5000..5000 ];
jsonfmt intl => 'Large integers', [ map { my $n=$_; map +($n+1<<$_), 10..60 } 1..10 ];
jsonfmt strs => 'ASCII strings', [ map +('hello, world', 'one more string', 'another string'), 1..100 ];
jsonfmt stru => 'Unicode strings', do { use utf8;
    [ map +('グリザイアの果実 -LE FRUIT DE LA GRISAIA-', '💩', 'Я люблю нічого не робити'), 1..50 ];
};
jsonfmt stres => 'String escaping (few)', [ map 'This string needs to "be escaped" a little bit', 1..100 ];
jsonfmt strel => 'String escaping (many)', [ map "This \" \\ needs \b\x01\x02\x03\x04 more", 1..100 ];

jsonfmt canons => 'Canonical hash key ordering (small)', [ map +{ map +("string$_", 1), 'a'..'f' }, 0..100 ];
jsonfmt canonl => 'Canonical hash key ordering (large)', { map +("string$_-something", 1), 'aa'..'zz' };



delete @data{ grep !$data{$_}{exists}, keys %data };

sub fmtbench($id, $text, $fs) {
    my $r = "$text\n\n";
    for my ($f, $m, $sub) (@$fs) {
        $m ||= $f;
        $r .= sprintf "%18s%10d/s\n", $f, $data{"$id $f $modules{$m}"}{rate};
    }
    "$r\n"
}

{
    open my $F, '>FU/Benchmarks.pod' or die $!;
    select $F;
    while (<DATA>) {
        s#^:modules#join '', map sprintf("=item L<%s> %s\n\n", $_, $modules{$_}), sort keys %modules#e;
        s#^:benches (.+)#join '', map fmtbench(@$_), grep $_->[0] =~ /$1/, @bench#e;
        print;
    }
    for (sort keys %data) {
        my $b = $data{$_};
        print join("\t", @{$b}{qw/ id func module modver rate /})."\n";
    }
}

__DATA__
=head1 NAME

FU::Benchmarks - A bunch of automated benchmark results.

=head1 DESCRIPTION

This file is automatically generated from 'bench.PL' in the L<FU> distribution.
These benchmarks compare performance of some FU functionality against similar
modules found on CPAN.

B<DISCLAIMER#1:> Obtaining accurate measurements is notoriously hard. Take the
numbers below with a few buckets of salt, any difference below 10% is most
likely noise.

B<DISCLAIMER#2:> Goodhart's law: "When a measure becomes a target, it ceases to
be a good measure". I've used these benchmarks to find and optimize hotspots in
FU, which in turn means these numbers may look better than they are in
real-world use.

=head1 MODULE VERSIONS

The following module versions were used:

=over

:modules

=back

=head1 BENCHMARKS

=head2 JSON Formatting

These benchmarks run on large-ish arrays with repeated values. JSON encoding is
sufficiently fast that Perl function calling overhead tends to dominate for
smaller inputs, but I don't find that overhead very interesting.

Also worth noting that JSON::SIMD formatting code is forked from JSON::XS, the
SIMD parts are only used for parsing.

:benches ^jsonfmt

=cut

# Cached data used by bench.PL.