From 7b8c5efa52161bcd99006e7986c6cb67f6475023 Mon Sep 17 00:00:00 2001

From: "Richard W.M. Jones" <rjones@redhat.com>

Date: Fri, 22 Apr 2016 16:32:24 +0100

Subject: [PATCH] tests: Add boot-benchmark-range script.

Add a script we can use to benchmark performance across a range of

commits in another project.

(cherry picked from commit 8299d7087a6457828a57ecace54c01b73912a9c7)

---

 docs/guestfs-performance.pod       |  14 +++

 tests/qemu/boot-benchmark-range.pl | 240 +++++++++++++++++++++++++++++++++++++

 2 files changed, 254 insertions(+)

 create mode 100755 tests/qemu/boot-benchmark-range.pl

diff --git a/docs/guestfs-performance.pod b/docs/guestfs-performance.pod

index cf30fdc..d9c76ac 100644

--- a/docs/guestfs-performance.pod

+++ b/docs/guestfs-performance.pod

@@ -589,6 +589,20 @@ breakpoints, etc.  Note that when you are past the BIOS and into the

 Linux kernel, you'll want to change the architecture back to 32 or 64

 bit.

+=head1 PERFORMANCE REGRESSIONS IN OTHER PROGRAMS

+

+Sometimes performance regressions happen in other programs (eg. qemu,

+the kernel) that cause problems for libguestfs.

+

+In the libguestfs source, F<tests/qemu/boot-benchmark-range.pl> is a

+script which can be used to benchmark libguestfs across a range of git

+commits in another project to find out if any commit is causing a

+slowdown (or speedup).

+

+To find out how to use this script, consult the manual:

+

+ ./tests/qemu/boot-benchmark-range.pl --man

+

 =head1 SEE ALSO

 L<supermin(1)>,

diff --git a/tests/qemu/boot-benchmark-range.pl b/tests/qemu/boot-benchmark-range.pl

new file mode 100755

index 0000000..0e31c4d

--- /dev/null

+++ b/tests/qemu/boot-benchmark-range.pl

@@ -0,0 +1,240 @@

+#!/usr/bin/env perl

+# Copyright (C) 2016 Red Hat Inc.

+#

+# This program is free software; you can redistribute it and/or modify

+# it under the terms of the GNU General Public License as published by

+# the Free Software Foundation; either version 2 of the License, or

+# (at your option) any later version.

+#

+# This program is distributed in the hope that it will be useful,

+# but WITHOUT ANY WARRANTY; without even the implied warranty of

+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+# GNU General Public License for more details.

+#

+# You should have received a copy of the GNU General Public License

+# along with this program; if not, write to the Free Software

+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

+

+use warnings;

+use strict;

+

+use Pod::Usage;

+use Getopt::Long;

+

+=head1 NAME

+

+boot-benchmark-range.pl - Benchmark libguestfs across a range of commits

+from another project

+

+=head1 SYNOPSIS

+

+ LIBGUESTFS_BACKEND=direct \

+ LIBGUESTFS_HV=/path/to/qemu/x86_64-softmmu/qemu-system-x86_64 \

+   ./run \

+   tests/qemu/boot-benchmark-range.pl /path/to/qemu HEAD~50..HEAD

+

+=head1

+

+Run F<tests/qemu/boot-benchmark> across a range of commits in another

+project.  This is useful for finding performance regressions in other

+programs such as qemu or the Linux kernel which might be affecting

+libguestfs.

+

+For example, suppose you suspect there has been a performance

+regression in qemu, somewhere between C<HEAD~50..HEAD>.  You could run

+the script like this:

+

+ LIBGUESTFS_BACKEND=direct \

+ LIBGUESTFS_HV=/path/to/qemu/x86_64-softmmu/qemu-system-x86_64 \

+   ./run \

+   tests/qemu/boot-benchmark-range.pl /path/to/qemu HEAD~50..HEAD

+

+where F</path/to/qemu> is the path to the qemu git repository.

+

+The output is a list of the qemu commits, annotated by the benchmark

+time and some other information about how the time compares to the

+previous commit.

+

+You should run these tests on an unloaded machine.  In particular

+running a desktop environment, web browser and so on can make the

+benchmarks useless.

+

+=head1 OPTIONS

+

+=over 4

+

+=cut

+

+my $help;

+

+=item B<--help>

+

+Display brief help.

+

+=cut

+

+my $man;

+

+=item B<--man>

+

+Display full documentation (man page).

+

+=cut

+

+my $benchmark_command;

+

+=item B<--benchmark> C<boot-benchmark>

+

+Set the name of the benchmark to run.  You only need to use this if

+the script cannot find the right path to the libguestfs

+F<tests/qemu/boot-benchmark> program.  By default the script looks for

+this file in the same directory as its executable.

+

+=cut

+

+my $make_command = "make";

+

+=item B<--make> C<make>

+

+Set the command used to build the other project.  The default is

+to run C<make>.

+

+If the command fails, then the commit is skipped.

+

+=back

+

+=cut

+

+# Clean up the program name.

+my $progname = $0;

+$progname =~ s{.*/}{};

+

+# Parse options.

+GetOptions ("help|?" => \$help,

+            "man" => \$man,

+            "benchmark=s" => \$benchmark_command,

+            "make=s" => \$make_command,

+    ) or pod2usage (2);

+pod2usage (-exitval => 0) if $help;

+pod2usage (-exitval => 0, -verbose => 2) if $man;

+

+die "$progname: missing argument: requires path to git repository and range of commits\n" unless @ARGV == 2;

+

+my $dir = $ARGV[0];

+my $range = $ARGV[1];

+

+die "$progname: $dir is not a git repository\n"

+    unless -d $dir && -d "$dir/.git";

+

+sub silently_run

+{

+    open my $saveout, ">&STDOUT";

+    open my $saveerr, ">&STDERR";

+    open STDOUT, ">/dev/null";

+    open STDERR, ">/dev/null";

+    my $ret = system (@_);

+    open STDOUT, ">&", $saveout;

+    open STDERR, ">&", $saveerr;

+    return $ret;

+}

+

+# Find the benchmark program and check it works.

+unless (defined $benchmark_command) {

+    $benchmark_command = $0;

+    $benchmark_command =~ s{/[^/]+$}{};

+    $benchmark_command .= "/boot-benchmark";

+

+    my $r = silently_run ("$benchmark_command", "--help");

+    die "$progname: cannot locate boot-benchmark program, try using --benchmark\n" unless $r == 0;

+}

+

+# Get the top-most commit from the remote, and restore it on exit.

+my $top_commit = `git -C '$dir' rev-parse HEAD`;

+chomp $top_commit;

+

+sub checkout

+{

+    my $sha = shift;

+    my $ret = silently_run ("git", "-C", $dir, "checkout", $sha);

+    return $ret;

+}

+

+END {

+    checkout ($top_commit);

+}

+

+# Get the range of commits and log messages.

+my @range = ();

+open RANGE, "git -C '$dir' log --reverse --oneline $range |" or die;

+while (<RANGE>) {

+    if (m/^([0-9a-f]+) (.*)/) {

+        my $sha = $1;

+        my $msg = $2;

+        push @range, [ $sha, $msg ];

+    }

+}

+close RANGE or die;

+

+# Run the test.

+my $prev_ms;

+foreach (@range) {

+    my ($sha, $msg) = @$_;

+    my $r;

+

+    print "\n";

+    print "$sha $msg\n";

+

+    # Checkout this commit in the other repo.

+    $r = checkout ($sha);

+    if ($r != 0) {

+        print "git checkout failed\n";

+        next;

+    }

+

+    # Build the repo, silently.

+    $r = silently_run ("cd $dir && $make_command");

+    if ($r != 0) {

+        print "build failed\n";

+        next;

+    }

+

+    # Run the benchmark program and get the timing.

+    my ($time_ms, $time_str);

+    open BENCHMARK, "$benchmark_command | grep '^Result:' |" or die;

+    while (<BENCHMARK>) {

+        die unless m/^Result: (([\d.]+)ms ±[\d.]+ms)/;

+        $time_ms = $2;

+        $time_str = $1;

+    }

+    close BENCHMARK;

+

+    print "\t", $time_str;

+    if (defined $prev_ms) {

+        if ($prev_ms > $time_ms) {

+            my $pc = 100 * ($prev_ms-$time_ms) / $time_ms;

+            if ($pc >= 1) {

+                printf (" ↑ improves performance by %0.1f%%", $pc);

+            }

+        } elsif ($prev_ms < $time_ms) {

+            my $pc = 100 * ($time_ms-$prev_ms) / $prev_ms;

+            if ($pc >= 1) {

+                printf (" ↓ degrades performance by %0.1f%%", $pc);

+            }

+        }

+    }

+    print "\n";

+    $prev_ms = $time_ms;

+}

+

+=head1 SEE ALSO

+

+L<git(1)>,

+L<guestfs-performance(1)>.

+

+=head1 AUTHOR

+

+Richard W.M. Jones.

+

+=head1 COPYRIGHT

+

+Copyright (C) 2016 Red Hat Inc.

-- 

2.7.4