t/load-save-speed.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Benchmark 'timethis';
   7 use JSON;
   8 use Sys::Hostname;
   9 use File::Path 'mkpath';
  10
  11 use Text::Tradition;
  12 use Text::Tradition::Directory;
  13 use Test::More;
  14 use Test::Memory::Cycle;
  15
  16 ## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
  17
  18 if($ENV{HARNESS_ACTIVE}) {
  19     plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements';
  20 } else {
  21     plan 'no_plan';
  22 }
  23
  24 ## Using t/data/besoin.xml  / t/data/besoin.dot as a large test example:
  25 my $test_name = 'besoin';
  26 # my $test_name = 'simple';
  27
  28 ## Data file for repeated benchmarks:
  29 my $benchmark_file = 't/data/load-save-benchmark.json';
  30
  31 ## SQL file (previously dumped KiokuDB) for testing tradition directory loading:
  32 # my $load_sql = 't/data/speed_test_load.sql';
  33
  34 ## uuid to load from the above stored db:
  35 my $load_uuid = 'load-test';
  36
  37 ## Pass the git hash to identify this performance improvement, if you
  38 ## want to save the results of this run. Pass nothing to just run a test
  39 ## of the current code against the previous best.
  40 my $git_hash = shift;
  41
  42 if($git_hash) {
  43     diag "Will save results using $git_hash as a key";
  44 } else {
  45     diag "No git hash passed in, just running test";
  46 }
  47
  48 ## Setup
  49 mkpath('t/var') if(!-d 't/var');
  50
  51 my $tradition = Text::Tradition->new(
  52    'input' => 'Self',
  53    'file'  => "t/data/${test_name}.xml"
  54     ## smaller for testing the test!
  55 #    'input' => 'Tabular',
  56 #    'file' => 't/data/simple.txt',
  57 );
  58 $tradition->add_stemma(dotfile => "t/data/${test_name}.dot");
  59
  60 #my $fh = File::Temp->new();
  61 #my $file = $fh->filename;
  62 #$fh->close;
  63 ## use t/var so you can look at the results after if neccessary:
  64
  65 #my $load_db = 't/var/speed_test_load.db';
  66 #unlink($load_db) if(-e $load_db);
  67 #my $load_dsn = "dbi:SQLite:dbname=$load_db";
  68 ## Prime db from .sql file:
  69 ## ?? fails
  70
  71 #`sqlite3 $load_db < $load_sql`;
  72
  73 my $save_db = 't/var/speed_test_save.db';
  74 unlink($save_db) if(-e $save_db);
  75 my $save_dsn = "dbi:SQLite:dbname=${save_db}";
  76
  77 my $benchmark_data = load_benchmark($benchmark_file);
  78
  79 my $test_save = sub {
  80     unlink($save_db) if(-e $save_db);
  81
  82     my $dir = Text::Tradition::Directory->new(
  83         dsn => $save_dsn,
  84         extra_args => { create => 1 },
  85     );
  86     ## This seems to be a required magic incantation:
  87     my $scope = $dir->new_scope;
  88
  89     ## save the tradition (with stemma) to the db:
  90     $dir->save($load_uuid => $tradition);
  91 #    print STDERR "UUID: $uuid\n";
  92
  93 };
  94
  95 my $test_load = sub {
  96     my $dir = Text::Tradition::Directory->new(
  97         dsn => $save_dsn,
  98     );
  99
 100     ## This seems to be a required magic incantation:
 101     my $scope = $dir->new_scope;
 102     my $t = $dir->tradition($load_uuid);
 103     return $t;
 104 #    print STDERR $load_tradition->name, $tradition->name, "\n";
 105 };
 106
 107 ## Find most recent benchmark info on this hostname
 108 my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
 109
 110 if(!$last_benchmark) {
 111     diag "Can't find last benchmark for " . hostname() . ", starting again";
 112     $last_benchmark = fresh_benchmark();
 113 }
 114
 115
 116 # Benchmark current code:
 117 # Should probably run the test the same number of times as the last time it ran
 118 # Or compare results more sanely
 119 my $new_save_result = timethis(5, $test_save);
 120
 121 my $new_save = $new_save_result->[1] + $new_save_result->[2];
 122 #use Data::Dump;
 123
 124 my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
 125 ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
 126
 127 my $new_load_result = timethis(5, $test_load);
 128
 129 my $new_load = $new_load_result->[1] + $new_load_result->[2];
 130 my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
 131 ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
 132
 133 my $load_tradition = $test_load->();
 134 isa_ok($load_tradition, 'Text::Tradition');
 135 ok($load_tradition->collation->as_svg());
 136
 137 if($git_hash) {
 138     push(@{ $benchmark_data }, {
 139         git_hash => $git_hash,
 140         host => hostname(),
 141         load_times => [@$new_load_result],
 142         save_times => [@$new_save_result],
 143     });
 144
 145     save_benchmark($benchmark_file, $benchmark_data);
 146 }
 147
 148 # -----------------------------------------------------------------------------
 149
 150 sub load_benchmark {
 151     my ($filename) = @_;
 152
 153     my $loaded_data = [];
 154     if(-e $filename) {
 155         local $/;
 156         open( my $fh, '<', $filename ) || die "$!";
 157         my $json_text   = <$fh>;
 158         $fh->close();
 159         $loaded_data = decode_json( $json_text );
 160     } else {
 161         ## bare bones default table:
 162         $loaded_data = fresh_benchmark();
 163     }
 164
 165     return $loaded_data;
 166 }
 167
 168 sub fresh_benchmark {
 169     return {
 170              git_hash => '',
 171              host => hostname(),
 172              load_times => [1000, 1000, 1000, 0, 0, 5],
 173              save_times => [1000, 1000, 1000, 0, 0, 20],
 174          }
 175 }
 176
 177 sub save_benchmark {
 178     my ($filename, $new_benchmarks) = @_;
 179
 180     my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
 181
 182     open(my $fh, '>', $filename) || die "$!";
 183     $fh->print($json_text);
 184     $fh->close();
 185 }