From aee09bb34099706d1560f4d059b7ea710f43cb3d Mon Sep 17 00:00:00 2001 From: fluks Date: Tue, 6 Jan 2015 03:15:57 +0200 Subject: [PATCH] Add time functions Add functions to test run time of the command. The functions are: - time_lt($cmd, $seconds, $name) - time_gt($cmd, $seconds, $name) - time_value($cmd) --- MANIFEST | 1 + lib/Test/Command.pm | 99 ++++++++++++++++++++++++++++++++++++++++----- t/05-object.t | 8 +++- t/07-time.t | 31 ++++++++++++++ 4 files changed, 127 insertions(+), 12 deletions(-) create mode 100644 t/07-time.t diff --git a/MANIFEST b/MANIFEST index a81b247..b25e6d3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -12,5 +12,6 @@ t/03-stdout.t t/04-stderr.t t/05-object.t t/06-signal.t +t/07-time.t t/pod-coverage.t t/pod.t diff --git a/lib/Test/Command.pm b/lib/Test/Command.pm index 8bbd0f6..52cbb6c 100644 --- a/lib/Test/Command.pm +++ b/lib/Test/Command.pm @@ -5,6 +5,7 @@ use strict; use Carp qw/ confess /; use File::Temp qw/ tempfile /; +use Time::HiRes qw/ gettimeofday tv_interval /; use base 'Test::Builder::Module'; @@ -45,6 +46,9 @@ our @EXPORT = qw( stderr_cmp_ok stderr_is_file + time_lt + time_gt + time_value ); =head1 NAME @@ -99,6 +103,13 @@ Test the exit status, signal, STDOUT or STDERR of an external command. stderr_unlike($cmd, /rre/); stderr_cmp_ok($cmd, 'eq', "err\n"); + ## testing time + + $cmd = 'sleep 2'; + + time_lt($cmd, 2.5); ## floating-point accuracy + time_gt($cmd, 1.5); + ## run-once-test-many-OO-style ## the first test lazily runs command ## the second test uses cached results @@ -115,12 +126,14 @@ Test the exit status, signal, STDOUT or STDERR of an external command. ## arbitrary results inspection - is( $echo_test->exit_value, 0, 'echo exit' ); - is( $echo_test->signal_value, undef, 'echo signal' ); - is( $echo_test->stdout_value, "out\n", 'echo stdout' ); - is( $echo_test->stderr_value, '', 'echo stderr' ); - is( -s $echo_test->stdout_file, 4, 'echo stdout file size' ); - is( -s $echo_test->stderr_file, 0, 'echo stderr file size' ); + is( $echo_test->exit_value, 0, 'echo exit' ); + is( $echo_test->signal_value, undef, 'echo signal' ); + is( $echo_test->stdout_value, "out\n", 'echo stdout' ); + is( $echo_test->stderr_value, '', 'echo stderr' ); + is( -s $echo_test->stdout_file, 4, 'echo stdout file size' ); + is( -s $echo_test->stderr_file, 0, 'echo stderr file size' ); + ok( $echo_test->time_value > 0.00001 && + $echo_test->time_value < 0.01, 'command ran between 0.00001 and 0.01 seconds' ); =head1 DESCRIPTION @@ -223,6 +236,7 @@ sub run $self->{'result'}{'term_signal'} = $run_info->{'term_signal'}; $self->{'result'}{'stdout_file'} = $run_info->{'stdout_file'}; $self->{'result'}{'stderr_file'} = $run_info->{'stderr_file'}; + $self->{'result'}{'time_delta'} = $run_info->{'time_delta'}; return $self; @@ -409,8 +423,12 @@ sub _run_cmd open STDOUT, '>&' . fileno $temp_stdout_fh or confess 'Cannot duplicate temporary STDOUT'; open STDERR, '>&' . fileno $temp_stderr_fh or confess 'Cannot duplicate temporary STDERR'; + my $t0 = [ gettimeofday() ]; + ## run the command system(@{ $cmd }); + + my $t_delta = tv_interval($t0); my $system_return = defined ${^CHILD_ERROR_NATIVE} ? ${^CHILD_ERROR_NATIVE} : $?; @@ -438,7 +456,8 @@ sub _run_cmd return { exit_status => $exit_status, term_signal => $term_signal, stdout_file => $temp_stdout_file, - stderr_file => $temp_stderr_file }; + stderr_file => $temp_stderr_file, + time_delta => $t_delta, }; } @@ -1162,6 +1181,68 @@ EOD return $is_ok; } +=head2 Testing time + +The test routines below measure the running time of the command. + +=head3 time_lt + + time_lt($cmd, $seconds, $name) + +If running the command takes less than given seconds, this passes. Otherwise +it fails. + +=cut + +sub time_lt + { + my ($cmd, $seconds, $name) = @_; + + my $result = _get_result($cmd); + + $name = _build_name($name, @_); + + return __PACKAGE__->builder->cmp_ok($result->{time_delta}, '<', $seconds, $name); + } + +=head3 time_gt + + time_gt($cmd, $seconds, $name) + +If running the command takes more than given seconds, this passes. Otherwise +it fails. + +=cut + +sub time_gt + { + my ($cmd, $seconds, $name) = @_; + + my $result = _get_result($cmd); + + $name = _build_name($name, @_); + + return __PACKAGE__->builder->cmp_ok($result->{time_delta}, '>', $seconds, $name); + } + +=head3 time_value + + time_value($cmd) + +Return the time it took to run the command. Useful for performing arbitrary tests +not covered by this module. + +=cut + +sub time_value + { + my ($cmd) = @_; + + my $result = _get_result($cmd); + + return $result->{time_delta}; + } + =head1 AUTHOR Daniel B. Boorstein, C<< >> @@ -1236,10 +1317,6 @@ under the same terms as Perl itself. =over 3 -=item * time_lt($cmd, $seconds) - -=item * time_gt($cmd, $seconds) - =item * stdout_line_custom($cmd, \&code) =item * stderr_line_custom($cmd, \&code) diff --git a/t/05-object.t b/t/05-object.t index b940be8..3c1835f 100644 --- a/t/05-object.t +++ b/t/05-object.t @@ -1,6 +1,6 @@ #!perl -use Test::More tests => 38; +use Test::More tests => 41; use Test::Command; @@ -59,6 +59,12 @@ $test_perl->stderr_unlike(qr/BAR\nFOO/); $test_perl->stderr_cmp_ok('ne', "foo\nbar\n"); $test_perl->stderr_is_file("$FindBin::Bin/stderr.txt"); +my $time = $test_perl->time_value; +ok( $time > 0.0001 && $time < 0.1, 'command ran between 0.0001 and 0.1 seconds' ); + +$test_perl->time_gt(0.0001); +$test_perl->time_lt(0.1); + ## test object with ARRAY ref command $test_perl = Test::Command->new( cmd => [$^X, diff --git a/t/07-time.t b/t/07-time.t new file mode 100644 index 0000000..6cdf69b --- /dev/null +++ b/t/07-time.t @@ -0,0 +1,31 @@ +#!perl + +use strict; +use warnings; + +use Test::Command tests => 3; + +use Test::More; + +## determine whether we can run perl or not + +system qq($^X -e 1) and BAIL_OUT('error calling perl via system'); + +my $time = time_value(_sleep_secs(0.01)); +ok( $time > 0.001 && $time < 0.1, + 'command sleeps between 0.001 and 0.1 seconds' ); + +time_lt(_sleep_secs(0.01), 0.1); + +time_gt(_sleep_secs(0.01), 0.005); + +## sleep given seconds using system calling perl +sub _sleep_secs + { + my ($seconds) = @_; + + my $MICROSECONDS_IN_ONE_SECOND = 1_000_000; + $seconds *= $MICROSECONDS_IN_ONE_SECOND; + + return qq($^X -MTime::HiRes=usleep -e "usleep $seconds"); + }