diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/XML/benchmark.pl')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/XML/benchmark.pl | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/XML/benchmark.pl b/Master/tlpkg/tlperl/lib/XML/benchmark.pl new file mode 100755 index 00000000000..0435116055c --- /dev/null +++ b/Master/tlpkg/tlperl/lib/XML/benchmark.pl @@ -0,0 +1,268 @@ +use Benchmark; +use Getopt::Long; +use File::Basename; +use XML::XPath; +use strict; + +$|++; + +my @default_drivers = qw( + LibXSLT + Sablotron + ); + +use vars qw( + $component $iter $ms $kb_in $kb_out $kb_sec $result $ref_size + ); + +my @getopt_args = ( + 'c=s', # config file + 'n=i', # number of benchmark times + 'd=s@', # drivers + 't', # only 1 iteration per test + 'v', # verbose + 'h', # help + 'x', # XSLTMark emulation + ); + +my %options; + +Getopt::Long::config("bundling"); + +unless (GetOptions(\%options, @getopt_args)) { + usage(); +} + +usage() if $options{h}; + +$options{c} ||= 'testcases/default.conf'; + +my $basedir = dirname($options{c}); + +$options{d} ||= [@default_drivers]; + +$options{n} ||= 1; + +# load drivers +for my $driver (@{$options{d}}) { + warn "Loading $driver Driver\n" if $options{v}; + require "Driver/$driver.pm"; +} + +# load config +my @config; +open(CONFIG, $options{c}) || die "Can't open config file '$options{c}' : $!"; +my $current = {}; +while(my $line = <CONFIG>) { + if ($line =~ /^\s*$/m && %$current) { + push @config, $current; + $current = {}; + } + + # ignore comments and full line comments + $line =~ s/#.*$//; + next unless $line =~ /\S/; + + if ($line =~ /^\s*\[(.*)\]\s*$/) { + $current->{component} = $1; + } + elsif ($line =~ /^(.*?)\s*=\s*(.*)$/) { + $current->{$1} = $2; + } +} + +for my $driver (@{$options{d}}) { + my $pkg = "Driver::${driver}"; + + $pkg->can('init')->(verbose => $options{v}); + + $pkg->can('chdir')->($basedir); + + print "Testing: $driver\n\n"; + + print_header(); + + my %totals; + + COMPONENT: + for my $cmp (@config) { + warn "Running test: $cmp->{component}\n" if $options{v}; + for (1..$options{n}) { + $component = $cmp->{component}; + $iter = $ms = $kb_in = $kb_out = $kb_sec = $ref_size = 0; + + if ($cmp->{skipdriver} =~ /\b\Q$driver\E\b/) { + $result = 'SKIPPED'; + print_output() unless $cmp->{written}; + $cmp->{written}++; + next COMPONENT; + } + + eval { + $pkg->can('load_stylesheet')->($cmp->{stylesheet}); + $pkg->can('load_input')->($cmp->{input}); + + $iter = $cmp->{iterations}; + $iter = 1 if $options{t}; + + + my $bench = timeit($iter, sub { + $pkg->can('run_transform')->($cmp->{output}); + }); + + my $str = timestr($bench, 'all', '5.4f'); + + if ($str =~ /\((\d+\.\d+)/) { + $ms = $1; + $ms *= 1000; + } + + $kb_in = (stat($cmp->{input}))[7]; + + if ($options{x}) { + $kb_in /= 1000; + } + else { + $kb_in += (stat($cmp->{stylesheet}))[7]; + $kb_in /= 1024; + } + + $kb_in *= $iter; + + $kb_out = (stat($cmp->{output}))[7]; + $kb_out /= 1024; + $kb_out *= $iter; + + die "failed - no output\n" unless $kb_out > 0; + + $kb_sec = ($kb_in + $kb_out) / + ( $ms / 500 ); + + if ($cmp->{reference}) { + $ref_size = (stat($cmp->{reference}))[7]; + $ref_size /= 1024; + + open(REFERENCE, $cmp->{reference}) || die "Can't open reference '$cmp->{reference}' : $!"; + open(NEW, $cmp->{output}) || die "Can't open transform output '$cmp->{output}' : $!"; + local $/; + my $ref = <REFERENCE>; + my $new = <NEW>; + close REFERENCE; + close NEW; + $new =~ s/\A<\?xml.*?\?>\s*//; + $new =~ s/\A<!DOCTYPE.*?>\s*//; + + if (!length($new)) { + die "output length failed\n"; + } + if ($new eq $ref) { + $result = 'OK'; + } + else { + $result = 'CHECK OUTPUT'; + eval { + my $rpp = XML::XPath->new(xml => $ref); + my $ppp = XML::XPath::XMLParser->new(xml => $new); + my $npp; + eval { + $npp = $ppp->parse; + }; + if ($@) { + $npp = $ppp->parse("<norm>$new</norm>"); + } + my @rnodes = $rpp->findnodes('//*'); + my @nnodes = $npp->findnodes('//*'); +# warn "ref nodes: ", scalar(@rnodes), "\n"; +# warn "new nodes: ", scalar(@nnodes), "\n"; + if (@rnodes == @nnodes) { + $result = 'COUNT OK'; + } + }; + if ($@) { + warn $@ if $options{v}; + } + } + } + else { + $result = 'NO REFERENCE'; + } + }; + if ($@) { + warn "$component failed: $@" if $options{v}; + $result = 'ERROR'; + } + + if (($result =~ /OK/) || ($result eq 'NO REFERENCE')) { + $totals{iter} += $iter; + $totals{ms} += $ms; + $totals{kb_in} += $kb_in; + $totals{kb_out} += $kb_out; + } + + print_output() unless $cmp->{written}; + $cmp->{written}++; + } # $options{n} loop + + delete $cmp->{written}; + } # each component + + $pkg->can('shutdown')->(); + + $component = 'total'; + $iter = $totals{iter}; + $ms = $totals{ms}; + $kb_in = $totals{kb_in}; + $kb_out = $totals{kb_out}; + $kb_sec = ($kb_in + $kb_out) / + ( $ms / 500 ); + $ref_size = 0; + $result = ''; + print_output(); +} + +sub usage { + print <<EOT; +usage: $0 [options] + + options: + + -c <file> load configuration from <file> + defaults to testcases/default.conf + + -n <num> run each test case <num> times. Default = 1. + + -t only one iteration per test case (note this + is different to -n 1) + + -d <Driver> test <Driver>. Use multiple -d options to test + more than one driver. Defaults are set in this + script (the \@default_drivers variable). + + -x XSLTMark emulation. Infuriatingly XSLTMark thinks + there are 1000 bytes in a Kilobyte. Someone please + tell them some basic computer science... + + Without this option, this benchmark also includes + the size of the stylesheet in the KB In figure. + + -v be verbose. + +Copyright 2001 AxKit.com Ltd. This is free software, you may use it and +distribute it under either the GNU GPL Version 2, or under the Perl +Artistic License. + +EOT + exit(0); +} + +sub print_header { + print STDOUT <<'EOF'; +Test Component Iter ms KB In KB Out KB/s Result +========================================================================== +EOF +} + +sub print_output { + printf STDOUT "%-15.15s %5.0d %5.0d %7.0f %7.0f %9.2f %-15.15s\n", + $component, $iter, $ms, $kb_in, $kb_out, $kb_sec, $result; +} |