[Templates-cvs] cvs commit: TT3/benchmark objmeth.pl passargs.pl textpos.pl
cvs@template-toolkit.org
cvs@template-toolkit.org
Fri, 19 Dec 2003 12:08:04 +0000
cvs 03/12/19 12:08:04
Added: benchmark objmeth.pl passargs.pl textpos.pl
Log:
added benchmark files
Revision Changes Path
1.1 TT3/benchmark/objmeth.pl
Index: objmeth.pl
===================================================================
#!/usr/bin/perl -w # -*- perl -*-
#
# Perl script to benchmark the difference between object method calls
# and regular subroutine calls.
#
use lib qw( ../lib );
use strict;
use Benchmark;
use Template::TT3::Base;
package BaseClass;
use base qw( Template::TT3::Base );
sub name { }
package SubClass;
use base qw( BaseClass );
sub name { }
package main;
my $base = BaseClass->new( name => 'Bob BaseClass' );
my $sub = SubClass->new( name => 'Sally SubClass' );
my $base_stub = $base->can('name');
my $sub_stub = $sub->can('name');
timethese( 10, {
method => \&method_call,
function => \&function_call,
stub => \&stub_call,
null => \&null_call,
});
sub method_call {
my $i = 1_000_000;
while ($i--) {
$base->name();
$sub->name();
}
}
sub function_call {
my $i = 1_000_000;
while ($i--) {
BaseClass::name($base);
SubClass::name($sub);
}
}
sub stub_call {
my $i = 1_000_000;
while ($i--) {
&$base_stub($base);
&$sub_stub($sub);
}
}
sub null_call {
my $i = 1_000_000;
while ($i--) {
}
}
__END__
Benchmark: timing 10 iterations of function, method, null, stub...
null: 5 wallclock secs ( 2.23 usr + 0.00 sys = 2.23 CPU)
@ 4.48/s (n=10)
function: 35 wallclock secs (17.29 usr + 0.04 sys = 17.33 CPU)
@ 0.58/s (n=10)
method: 39 wallclock secs (19.01 usr + 0.06 sys = 19.07 CPU)
@ 0.52/s (n=10)
stub: 35 wallclock secs (17.62 usr + 0.05 sys = 17.67 CPU)
@ 0.57/s (n=10)
null: 2.23
function: 17.33 - 2.23 = 15.10 / 15.10 = 1
method: 19.07 - 2.23 = 16.84 / 15.10 = 1.11
stub: 17.67 - 2.23 = 15.44 / 15.10 = 1.02
20 million calls in total.
function: 20_000_000 / 15.10 = 1_324_450 calls per second
method: 20_000_000 / 16.84 = 1_187_648 calls per second
stub: 20_000_000 / 15.44 = 1_295_336 calls per second
1.1 TT3/benchmark/passargs.pl
Index: passargs.pl
===================================================================
#!/usr/bin/perl -w # -*- perl -*-
#
# See if it's quicker to pass arguments to an object, or to preset
# them in the object. This relates to how the scanner passed state
# information (line number, start token, end token, etc) to tag
# objects.
#
# Conclusion:
# - it's fastest to just pass args:
# $foo->bar($a, $b, $c, $d);
# - but if the object is just going to stash them internally anyway:
# sub bar {
# my ($self, $a, $b, $c, $d) = @_;
# $self->{ a } = $a;
# $self->{ b } = $b;
# $self->{ c } = $c;
# $self->{ d } = $d;
# ...
# }
# then you might as well pre-set them (but only if you don't mind
# breaking encapsulation which we normally do, but in the case of
# scanner/tag we might get away with it)
# $foo->{ a } = $a;
# $foo->{ b } = $b;
# $foo->{ c } = $c;
# $foo->{ d } = $d;
# $foo->bar();
# - this is faster than setting them en masse
# @$foo{ qw( a b c d ) } = ($a, $b, $c, $d)
# - and that's twice as fast as having lots of method calls
# $foo->a($a);
# $foo->b($b);
# $foo->c($c);
# $foo->bar();
#
# Benchmark: timing 500000 iterations of pass_args, pre_glob, pre_method, pre_set...
# pass_args: 5 wallclock secs ( 2.78 usr + 0.02 sys = 2.80 CPU)
# @ 178571.43/s (n=500000)
# pre_set: 4 wallclock secs ( 2.26 usr + 0.01 sys = 2.27 CPU)
# @ 220264.32/s (n=500000)
# pre_glob: 8 wallclock secs ( 3.19 usr + 0.02 sys = 3.21 CPU)
# @ 155763.24/s (n=500000)
# pre_method: 16 wallclock secs ( 7.44 usr + 0.03 sys = 7.47 CPU)
# @ 66934.40/s (n=500000)
#
use strict;
use warnings;
our $DEBUG = grep(/^--?d(ebug)?$/, @ARGV);
package Foo;
use Class::Base;
use base qw( Class::Base );
sub bar {
my $self = shift;
if ($main::DEBUG) {
print "bar line: $self->{ line }\n";
print "bar size: $self->{ size }\n";
}
}
sub baz {
my ($self, $line, $size, $blim, $blam) = @_;
$self->{ line } = $line;
$self->{ size } = $size;
$self->{ blim } = $blim;
$self->{ blam } = $blam;
if ($main::DEBUG) {
print "baz line: $line\n";
print "baz size: $size\n";
}
}
sub line {
my $self = shift;
return @_ ? ($self->{ line } = shift) : $self->{ line };
}
sub size {
my $self = shift;
return @_ ? ($self->{ size } = shift) : $self->{ size };
}
sub blim {
my $self = shift;
return @_ ? ($self->{ blim } = shift) : $self->{ blim };
}
sub blam {
my $self = shift;
return @_ ? ($self->{ blam } = shift) : $self->{ blam };
}
package main;
use Benchmark;
my $foo = Foo->new();
sub pre_set {
$foo->{ line } = 10;
$foo->{ size } = 20;
$foo->{ blim } = 30;
$foo->{ blam } = 40;
$foo->bar();
}
sub pre_method {
$foo->line(10);
$foo->size(20);
$foo->blim(30);
$foo->blam(40);
$foo->bar();
}
sub pre_glob {
@$foo{ qw( line size blim blam ) } = (10, 20, 30, 40);
$foo->bar();
}
sub pass_args {
$foo->baz(30, 40, 50, 60);
}
timethese($DEBUG ? 1 : 500_000, {
pass_args => \&pass_args,
pre_set => \&pre_set,
pre_glob => \&pre_glob,
pre_method => \&pre_method,
});
1.1 TT3/benchmark/textpos.pl
Index: textpos.pl
===================================================================
#!/usr/bin/perl -w # -*- perl -*-
#
# Test script to explore the overhead of tracking the scanning position
# in a text string.
#
# null doesn't do any line counting
# count does line counting optimised for different tag styles (open/closed)
# pscan uses a post-scanning technique which makes the code nicer but isn't
# optimised for different tag types
# split even nicer architecture for the scanner with everything split
# into separate methods for better reusability, easier subclassing, etc.
#
#
# Benchmark: timing 1000 iterations of count, null, pscan, split...
# null: 88 wallclock secs (43.33 usr + 0.09 sys = 43.42 CPU)
# @ 23.03/s (n=1000)
# count: 99 wallclock secs (48.68 usr + 0.22 sys = 48.90 CPU)
# @ 20.45/s (n=1000)
# pscan: 103 wallclock secs (50.61 usr + 0.15 sys = 50.76 CPU)
# @ 19.70/s (n=1000)
# split: 126 wallclock secs (61.54 usr + 0.21 sys = 61.75 CPU)
# @ 16.19/s (n=1000)
#
# We're churning through approx 20 iterations a second and each has 1000 lines to
# be scanned, giving a scanning rate of approx 20k lines per second. Not bad.
# The overhead for keeping track of line numbers is about 12% which is quite
# acceptable for the benefit it brings. If it had been 50% I might have looked
# for a faster solution (which inevitably would have been less convenient for
# the user), but this is fine. Post-scanning is a little slower, but not
# terribly slow. The split scanner has an extra method call for every chunk
# of text or tag and is approx 40% slower than the regular counting scanner
# for the same functionality. So I think we'll be keeping it self-contained
# as per the count scanner.
#
# Benchmark: timing 500 iterations of count, null, pscan, split, tt2...
# count: 69 wallclock secs (33.81 usr + 0.13 sys = 33.94 CPU)
# @ 14.73/s (n=500)
# null: 63 wallclock secs (30.89 usr + 0.16 sys = 31.05 CPU)
# @ 16.10/s (n=500)
# pscan: 71 wallclock secs (34.61 usr + 0.11 sys = 34.72 CPU)
# @ 14.40/s (n=500)
# split: 83 wallclock secs (40.68 usr + 0.13 sys = 40.81 CPU)
# @ 12.25/s (n=500)
# tt2: 119 wallclock secs (58.63 usr + 0.23 sys = 58.86 CPU)
# @ 8.49/s (n=500)
#
#
use lib qw( lib ../lib );
use strict;
use Benchmark;
use Tag::Dir;
use Tag::Var;
use Document::List;
#use Template::Parser;
#use Test::More tests => 10;
my $DEBUG = grep(/^--?d(ebug)?$/, @ARGV);
$Document::List::DEBUG = $DEBUG;
local $/ = undef;
my $text = <DATA>;
$text = $text x 50 # 1000 lines to scan in total
unless $DEBUG;
my $dirpkg = 'Tag::Dir';
my $varpkg = 'Tag::Var';
my $docpkg = 'Document::List';
timethese( $DEBUG ? 1 : 1000, {
tt2null => \&tt2_null_scanner,
tt2inull => \&tt2_inull_scanner,
tt2list => \&tt2_list_scanner,
tt2handler => \&tt2_handler_scanner,
tt2ihandler => \&tt2_interp_scanner,
tt3null => \&tt3_null_scanner,
tt3inull => \&tt3_inull_scanner,
tt3nocount => \&tt3_nocount_scanner,
tt3count => \&tt3_count_scanner,
tt3split => \&tt3_split_scanner,
tt3pscan => \&tt3_post_scanner,
});
sub tt3_nocount_scanner {
my $scanner = make_scanner('Scanner::Null');
print STDERR "Testing TT3 nocount scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt3_count_scanner {
my $scanner = make_scanner('Scanner::Count');
print STDERR "Testing TT3 line counting scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt3_split_scanner {
my $scanner = make_scanner('Scanner::Split');
print STDERR "Testing TT3 split line counting scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt3_post_scanner {
my $scanner = make_scanner('Scanner::PostScan');
print STDERR "Testing TT3 post scan line counting scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt3_null_scanner {
my $scanner = make_scanner('Scanner::TT3::Null');
print STDERR "Testing TT3 null scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt3_inull_scanner {
my $scanner = make_iscanner('Scanner::TT3::Null');
print STDERR "Testing TT3 interp null scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_null_scanner {
my $scanner = make_scanner('Scanner::TT2::Null');
print STDERR "Testing TT2 null scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_inull_scanner {
my $scanner = make_scanner('Scanner::TT2::iNull');
print STDERR "Testing TT2 interp null scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_list_scanner {
my $scanner = make_scanner('Scanner::TT2::List');
print STDERR "Testing TT2 list scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_handler_scanner {
my $scanner = make_scanner('Scanner::TT2::Handler');
print STDERR "Testing TT2 handler scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_interp_scanner {
my $scanner = make_scanner('Scanner::TT2::Interp');
print STDERR "Testing TT2 interpolate scanner...\n" if $DEBUG;
run_scanner($scanner);
}
sub tt2_parser {
print STDERR "Testing TT2 parser...\n" if $DEBUG;
my $parser = Template::Parser->new();
my $tokens = $parser->split_text($text);
}
sub make_scanner {
my $scanpkg = shift;
my $scanmod = $scanpkg;
$scanmod =~ s[::][/]g;
$scanmod .= '.pm';
require $scanmod;
my $dirtag = $dirpkg->new()
|| die $dirpkg->error();
my $scanner = $scanpkg->new( tags => [ $dirtag ] )
|| die $scanpkg->error();
return $scanner;
}
sub make_iscanner {
my $scanpkg = shift;
my $scanmod = $scanpkg;
$scanmod =~ s[::][/]g;
$scanmod .= '.pm';
require $scanmod;
my $dirtag = $dirpkg->new()
|| die $dirpkg->error();
my $vartag = $varpkg->new()
|| die $varpkg->error();
my $scanner = $scanpkg->new( tags => [ $dirtag, $vartag ] )
|| die $scanpkg->error();
return $scanner;
}
sub run_scanner {
my $scanner = shift;
my $document = $docpkg->new( name => 'testdoc', text => $text )
|| die $docpkg->error();
$document->scan($scanner) || die $document->error();
}
__END__
aa aaa aaaaa aaaaaaa aaaaaaaaaaa aaaaaaaaaaaaa aaaaaaaaaaaaaaaaa
bb [%- foo on line 2 %] bbbbb [%bar baz both on 2 -%] bbbbbbb $x bbbb
ccc [% ping pong all sing along now on lines 3-5
hello world hello world hello world
%] eee [% lah lah lah on 5 =%] eeeeee lkjsdlfkj sldkfj lsdkjf lskdjf l
lkjsd lfkjs dlkfj sldkfj slkdjf lskdjf lskdjf lskdjf lskdjf lskdjf
$foobar $wingwan $blah blah [% more stuff on 7-14
in here in this directive
with a few newlines and lots more
other stuff inside it
going on for many
lines because that's one of the things
that we're testing
-%] lskdjf lskdjf lskdj flksdj flksjd flkjs dlfkjs dlkfj slkdj f
[% another directive about line 15 %] and some more text $bar $blah
foo bar [% hello again %] lksjdflksjdfkjd [% line 16-18 klsjd flkjsd lfkj
sldkfj sldkjf sldkjf lskdjf sldkj sdlkfj sdkjfh ksdhf ksjdhf kjh
slkdjf lskdjf slkdjf %] blah blah blah sdlkfj sdlkfj sldkfj slk $x
skdjflksjd flkjsd flkjsdflkj $kdhfksjdhfkjsdhf $kjsf lskdjflksdjf
$y $z last line 20 [% the last directive %] the last bit of text.