Add a benchmark script

diff --git a/author/pp-vs-xs-with-forking.pl b/author/pp-vs-xs-with-forking.pl
new file mode 100644 (file)
index 0000000..816113e
--- /dev/null
+++ b/author/pp-vs-xs-with-forking.pl
@@ -0,0 +1,55 @@
+#!perl -w
+
+use strict;
+use Config; printf "Perl/%vd (%s)\n", $^V, $Config{archname};
+
+use Benchmark qw(:hireswallclock);
+use Benchmark::Forking qw(cmpthese);
+
+use Encode (); # pre-load for Interface::Test
+use HTTP::Request ();
+
+sub new_he{
+    my($use_pp) = @_;
+    $ENV{MOUSE_PUREPERL} = $use_pp;
+
+    require HTTP::Engine;
+
+    return HTTP::Engine->new(
+        interface       => {
+            module => 'Test',
+            request_handler => sub {
+                my($request) = @_;
+
+                return HTTP::Engine::Response->new(body => "Hello, world!\n");
+            },
+        },
+    );
+}
+
+my $req = HTTP::Request->new(GET => 'http://localhost/');
+
+print "load HTTP::Engine, new(), and run()\n";
+cmpthese -1 => {
+     'XS' => sub {
+        my $he  = new_he(0);
+        $he->run($req, env => \%ENV);
+     },
+     'PP' => sub {
+        my $he  = new_he(1);
+        $he->run($req, env => \%ENV);
+     },
+};
+
+print "load HTTP::Engine, new(), and run() * 100\n";
+cmpthese -1 => {
+     'XS' => sub {
+        my $he  = new_he(0);
+        $he->run($req, env => \%ENV) for 1 .. 100;
+     },
+     'PP' => sub {
+        my $he = new_he(1);
+        $he->run($req, env => \%ENV) for 1 .. 100;
+     },
+};
+