use Benchmark 'timethis';
use JSON;
+use Sys::Hostname;
use File::Path 'mkpath';
use Text::Tradition;
use Text::Tradition::Directory;
-use Test::More 'no_plan';
+use Test::More;
+
+## Don't run this test when running make test or prove, to run it use perl -Ilib t/load-save-speed.t
+
+if($ENV{HARNESS_ACTIVE}) {
+ plan skip_all => 'Skipping performance tests under prove/make, run manually to test performance improvements';
+} else {
+ plan 'no_plan';
+}
## Using t/data/besoin.xml / t/data/besoin.dot as a large test example:
my $test_name = 'besoin';
my $load_sql = 't/data/speed_test_load.sql';
## uuid to load from the above stored db:
-my $load_uuid = '7D0AA7C0-92C2-11E1-98B2-D7BDA89F4671';
+my $load_uuid = 'load-test';
## Pass the git hash to identify this performance improvement, if you
## want to save the results of this run. Pass nothing to just run a test
};
+my $load_tradition;
my $test_load = sub {
my $dir = Text::Tradition::Directory->new(
- dsn => $save_dsn,
+ dsn => $load_dsn,
);
## This seems to be a required magic incantation:
my $scope = $dir->new_scope;
- my $tradition = $dir->tradition($load_uuid);
+ $load_tradition = $dir->tradition($load_uuid);
+# print STDERR $load_tradition->name, $tradition->name, "\n";
};
-my $last_benchmark = $benchmark_data->[-1];
+## Find most recent benchmark info on this hostname
+my ($last_benchmark) = grep { $_->{host} eq hostname() } (reverse @{$benchmark_data});
+
+if(!$last_benchmark) {
+ diag "Can't find last benchmark for " . hostname() . ", starting again";
+ $last_benchmark = fresh_benchmark();
+}
+
+
## Benchmark current code:
+## Should probably run the test the same number of times as the last time it ran
+## Or compare results more sanely
my $new_save_result = timethis(5, $test_save);
-ok($new_save_result->[1] + $new_save_result->[2] < $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2], 'Saving to a Tradition Directory got faster');
+my $new_save = $new_save_result->[1] + $new_save_result->[2];
+use Data::Dump;
+
+my $old_save = $last_benchmark->{save_times}[1] + $last_benchmark->{save_times}[2];
+ok( $new_save < $old_save, "Saving to a Tradition Directory got faster: $new_save vs $old_save");
my $new_load_result = timethis(20, $test_load);
-ok($new_load_result->[1] + $new_load_result->[2] < $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2], 'Loading from a Tradition Directory got faster');
+my $new_load = $new_load_result->[1] + $new_load_result->[2];
+my $old_load = $last_benchmark->{load_times}[1] + $last_benchmark->{load_times}[2];
+ok($new_load < $old_load, "Loading from a Tradition Directory got faster: $new_load vs $old_load");
+
+$test_load->();
+isa_ok($load_tradition, 'Text::Tradition');
+ok($load_tradition->collation->as_svg());
if($git_hash) {
push(@{ $benchmark_data }, {
git_hash => $git_hash,
- load_times => $new_load_result,
- save_times => $new_save_result,
+ host => hostname(),
+ load_times => [@$new_load_result],
+ save_times => [@$new_save_result],
});
- save_benchmark($benchmark_data);
+ save_benchmark($benchmark_file, $benchmark_data);
}
## -----------------------------------------------------------------------------
$loaded_data = decode_json( $json_text );
} else {
## bare bones default table:
- $loaded_data = [
- {
- git_hash => '',
- load_times => [1000, 1000, 1000, 0, 0, 5],
- save_times => [1000, 1000, 1000, 0, 0, 5],
- }
- ];
+ $loaded_data = fresh_benchmark();
}
return $loaded_data;
}
+sub fresh_benchmark {
+ return {
+ git_hash => '',
+ host => hostname(),
+ load_times => [1000, 1000, 1000, 0, 0, 5],
+ save_times => [1000, 1000, 1000, 0, 0, 20],
+ }
+}
+
sub save_benchmark {
my ($filename, $new_benchmarks) = @_;
- my $json_text = encode_json($new_benchmarks);
+ my $json_text = JSON->new->utf8->allow_blessed->encode($new_benchmarks);
open(my $fh, '>', $filename) || die "$!";
$fh->print($json_text);