r22453 - in /branches/upstream/libtest-mocktime-perl: ./ current/ current/lib/ current/lib/Test/ current/t/
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Jun 29 10:21:52 UTC 2008
Author: ansgar-guest
Date: Sun Jun 29 10:21:51 2008
New Revision: 22453
URL: http://svn.debian.org/wsvn/?sc=1&rev=22453
Log:
[svn-inject] Installing original source of libtest-mocktime-perl
Added:
branches/upstream/libtest-mocktime-perl/
branches/upstream/libtest-mocktime-perl/current/
branches/upstream/libtest-mocktime-perl/current/Changes
branches/upstream/libtest-mocktime-perl/current/MANIFEST
branches/upstream/libtest-mocktime-perl/current/META.yml
branches/upstream/libtest-mocktime-perl/current/Makefile.PL
branches/upstream/libtest-mocktime-perl/current/lib/
branches/upstream/libtest-mocktime-perl/current/lib/Test/
branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm (with props)
branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pod
branches/upstream/libtest-mocktime-perl/current/t/
branches/upstream/libtest-mocktime-perl/current/t/export.t
branches/upstream/libtest-mocktime-perl/current/t/prototypes.t
branches/upstream/libtest-mocktime-perl/current/t/string-time.t
branches/upstream/libtest-mocktime-perl/current/t/test.t (with props)
Added: branches/upstream/libtest-mocktime-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/Changes?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/Changes (added)
+++ branches/upstream/libtest-mocktime-perl/current/Changes Sun Jun 29 10:21:51 2008
@@ -1,0 +1,24 @@
+CHANGES
+-------
+
+ 0.07 - 05 September 2007
+
+ * including the missing t/prototypes.t into the MANIFEST so it actually gets included. *ZONK*
+
+ 0.06 - 04 September 2007
+
+ * fixing a call to Exporter to allow Test::MockTime on perl 5.6.1 to run, although still with warnings about prototypes
+ * including the missing t/prototypes.t that Peter sent me.
+
+ 0.05 - 28 December 2006
+
+ * Patch from Peter du Marchie van Voorthuysen to give the correct function prototypes for gmtime, localtime and time
+ * now only requiring Time::Piece when using specs
+
+ 0.04 - 31 July 2006
+
+ * Patch from Michael Hendricks to allow importing all subroutines
+
+ 0.03 - 30 July 2006
+
+ * Patch from Michael Hendricks to allow dates in formats other than seconds since the unix epoch
Added: branches/upstream/libtest-mocktime-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/MANIFEST?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/MANIFEST (added)
+++ branches/upstream/libtest-mocktime-perl/current/MANIFEST Sun Jun 29 10:21:51 2008
@@ -1,0 +1,10 @@
+MANIFEST
+Makefile.PL
+Changes
+t/export.t
+t/test.t
+t/string-time.t
+t/prototypes.t
+lib/Test/MockTime.pm
+lib/Test/MockTime.pod
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libtest-mocktime-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/META.yml?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/META.yml (added)
+++ branches/upstream/libtest-mocktime-perl/current/META.yml Sun Jun 29 10:21:51 2008
@@ -1,0 +1,13 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Test-MockTime
+version: 0.07
+version_from: lib/Test/MockTime.pm
+installdirs: site
+requires:
+ Test::More: 0
+ Time::Local: 0
+ Time::Piece: 1.08
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
Added: branches/upstream/libtest-mocktime-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/Makefile.PL?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/Makefile.PL (added)
+++ branches/upstream/libtest-mocktime-perl/current/Makefile.PL Sun Jun 29 10:21:51 2008
@@ -1,0 +1,12 @@
+
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ 'NAME' => 'Test::MockTime',
+ 'VERSION_FROM' => 'lib/Test/MockTime.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => 0,
+ 'Time::Local' => 0,
+ 'Time::Piece' => '1.08',
+ },
+);
Added: branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm (added)
+++ branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm Sun Jun 29 10:21:51 2008
@@ -1,0 +1,93 @@
+package Test::MockTime;
+
+use strict;
+use warnings;
+use Carp();
+use Exporter();
+*import = \&Exporter::import;
+our @EXPORT_OK = qw(
+ set_relative_time
+ set_absolute_time
+ set_fixed_time
+ restore_time
+);
+our %EXPORT_TAGS = (
+ 'all' => \@EXPORT_OK,
+);
+our ($VERSION) = '0.07';
+our ($offset) = 0;
+our ($fixed) = undef;
+
+BEGIN {
+ *CORE::GLOBAL::time = \&Test::MockTime::time;
+ *CORE::GLOBAL::localtime = \&Test::MockTime::localtime;
+ *CORE::GLOBAL::gmtime = \&Test::MockTime::gmtime;
+}
+
+sub set_relative_time {
+ my ($relative) = @_;
+ if (($relative eq __PACKAGE__) || (UNIVERSAL::isa($relative, __PACKAGE__))) {
+ Carp::carp("Test::MockTime::set_relative_time called incorrectly\n");
+ }
+ $offset = $_[-1]; # last argument. might have been called in a OO syntax?
+}
+
+sub _time {
+ my ($time, $spec) = @_;
+ unless ($time =~ /\A -? \d+ \z/xms) {
+ $spec ||= '%Y-%m-%dT%H:%M:%SZ';
+ }
+ if ($spec) {
+ require Time::Piece;
+ $time = Time::Piece->strptime($time, $spec)->epoch();
+ }
+ return $time;
+}
+
+sub set_absolute_time {
+ my ($time, $spec) = @_;
+ if (($time eq __PACKAGE__) || (UNIVERSAL::isa($time, __PACKAGE__))) {
+ Carp::carp("Test::MockTime::set_absolute_time called incorrectly\n");
+ }
+ $time = _time($time, $spec);
+ $offset = $time - CORE::time;
+}
+
+sub set_fixed_time {
+ my ($time, $spec) = @_;
+ if (($time eq __PACKAGE__) || (UNIVERSAL::isa($time, __PACKAGE__))) {
+ Carp::carp("Test::MockTime::set_fixed_time called incorrectly\n");
+ }
+ $time = _time($time, $spec);
+ $fixed = $time;
+}
+
+sub time() {
+ if (defined $fixed) {
+ return $fixed;
+ } else {
+ return (CORE::time + $Test::MockTime::offset);
+ }
+}
+
+sub localtime (;$) {
+ my ($time) = @_;
+ unless (defined $time) {
+ $time = Test::MockTime::time();
+ }
+ return CORE::localtime($time);
+}
+
+sub gmtime (;$) {
+ my ($time) = @_;
+ unless (defined $time) {
+ $time = Test::MockTime::time();
+ }
+ return CORE::gmtime($time);;
+}
+
+sub restore {
+ $offset = 0;
+ $fixed = undef;
+}
+*restore_time = \&restore;
Propchange: branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pm
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pod?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pod (added)
+++ branches/upstream/libtest-mocktime-perl/current/lib/Test/MockTime.pod Sun Jun 29 10:21:51 2008
@@ -1,0 +1,140 @@
+
+=head1 NAME
+
+Test::MockTime - Replaces actual time with simulated time
+
+=head1 SYNOPSIS
+
+ use Test::MockTime qw( :all );
+ set_relative_time(-600);
+
+ # do some tests depending on time increasing from 600 seconds ago
+
+ set_absolute_time(0);
+
+ # do some more tests depending on time starting from the epoch
+ # epoch may vary according to platform. see perlport.
+
+ set_fixed_time(CORE::time());
+
+ # do some more tests depending on time staying at the current actual time
+
+ set_absolute_time('1970-01-01T00:00:00Z');
+
+ # do some tests depending on time starting at Unix epoch time
+
+ set_fixed_time('01/01/1970 00:00:00', '%m/%d/%Y %H:%M:%S');
+
+ # do some tests depending on time staying at the Unix epoch time
+
+ restore_time();
+
+ # resume normal service
+
+=head1 DESCRIPTION
+
+This module was created to enable test suites to test code at specific
+points in time. Specifically it overrides localtime, gmtime and time at
+compile time and then relies on the user supplying a mock time via
+set_relative_time, set_absolute_time or set_fixed_time to alter future
+calls to gmtime,time or localtime.
+
+=head1 Functions
+
+=item set_absolute_time
+
+If given a single, numeric argument, the argument is an absolute time (for
+example, if 0 is supplied, the absolute time will be the epoch), and
+calculates the offset to allow subsequent calls to time, gmtime and localtime
+to reflect this.
+
+for example, in the following code
+
+ Time::Mock::set_absolute_time(0);
+ my ($start) = time;
+ sleep 2;
+ my ($end) = time;
+
+The $end variable should contain 2 seconds past the epoch;
+
+If given two arguments, the first argument is taken to be an absolute time in
+some string format (for example, "01/01/1970 00:00:00"). The second argument
+is taken to be a C<strptime> format string (for example, "%m/%d/%Y %H:%M:%S").
+If a single argument is given, but that argument is not numeric, a
+C<strptime> format string of "%Y-%m-%dT%H:%M:%SZ" is assumed.
+
+for example, in the following code
+
+ Time::Mock::set_absolute_time('1970-01-01T00:00:00Z');
+ my ($start) = time;
+ sleep 2;
+ my ($end) = time;
+
+The $end variable should contain 2 seconds past the Unix epoch;
+
+=item set_relative_time($relative)
+
+takes as an argument an relative value from current time (for example, if -10
+is supplied, current time be converted to actual machine time - 10 seconds)
+and calculates the offset to allow subsequent calls to time,gmtime and localtime
+to reflect this.
+
+for example, in the following code
+
+ my ($start) = time;
+ Time::Mock::set_relative_time(-600);
+ sleep 600;
+ my ($end) = time;
+
+The $end variable should contain either the same or very similar values to the
+$start variable.
+
+=item set_fixed_time
+
+If given a single, numeric argument, the argument is an absolute time (for
+example, if 0 is supplied, the absolute time will be the epoch). All
+subsequent calls to gmtime, localtime and time will return this value.
+
+for example, in the following code
+
+ Time::Mock::set_fixed_time(time)
+ my ($start) = time;
+ sleep 3;
+ my ($end) = time;
+
+the $end variable and the $start variable will contain the same results
+
+If given two arguments, the first argument is taken to be an absolute time in
+some string format (for example, "01/01/1970 00:00:00"). The second argument
+is taken to be a C<strptime> format string (for example, "%m/%d/%Y %H:%M:%S").
+If a single argument is given, but that argument is not numeric, a
+C<strptime> format string of "%Y-%m-%dT%H:%M:%SZ" is assumed.
+
+=item restore()
+
+restore the default time handling values. C<restore_time> is an alias. When
+exported with the 'all' tag, this subroutine is exported as C<restore_time>.
+
+=head1 AUTHOR
+
+David Dick <ddick at cpan.org>
+
+=head1 PREREQUISITES
+
+Time::Piece 1.08 or greater
+
+=head1 BUGS
+
+Probably.
+
+=head1 COPYRIGHT
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to a use.perl.org journal entry <http://use.perl.org/~geoff/journal/20660> by
+Geoffrey Young.
Added: branches/upstream/libtest-mocktime-perl/current/t/export.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/t/export.t?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/t/export.t (added)
+++ branches/upstream/libtest-mocktime-perl/current/t/export.t Sun Jun 29 10:21:51 2008
@@ -1,0 +1,12 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+use Test::MockTime qw( :all );
+
+eval{
+ set_relative_time(1);
+ set_absolute_time(2);
+ set_fixed_time(3);
+ restore_time;
+};
+is( $@, q{}, ':all export tag works' );
Added: branches/upstream/libtest-mocktime-perl/current/t/prototypes.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/t/prototypes.t?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/t/prototypes.t (added)
+++ branches/upstream/libtest-mocktime-perl/current/t/prototypes.t Sun Jun 29 10:21:51 2008
@@ -1,0 +1,18 @@
+#! /usr/bin/perl
+use Test::MockTime ':all';
+use Test::More tests => 3;
+use strict;
+use warnings;
+
+set_fixed_time(2);
+my $four = time + 2;
+is($four, 4, "time() does not try so slurp any arguments");
+
+my @arr = (0, 1, 2);
+my $got = localtime @arr;
+my $expect = localtime scalar @arr;
+is($got, $expect, "localtime() treats its argument as an expression");
+
+$got = gmtime @arr;
+$expect = gmtime scalar @arr;
+is($got, $expect, "gmtime() treats its argument as an expression");
Added: branches/upstream/libtest-mocktime-perl/current/t/string-time.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/t/string-time.t?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/t/string-time.t (added)
+++ branches/upstream/libtest-mocktime-perl/current/t/string-time.t Sun Jun 29 10:21:51 2008
@@ -1,0 +1,73 @@
+#! /usr/bin/perl
+
+use Test::MockTime();
+use Test::More(tests => 18);
+use Time::Local();
+use strict;
+use warnings;
+
+my ($mock, $real);
+
+# determine the correct epoch value for our test time
+my $TRUE = Time::Local::timegm(19, 25, 3, 30, 6, 2006);
+
+# set_absolute_time with a defaulted date spec
+Test::MockTime::set_absolute_time('2006-07-30T03:25:19Z');
+$mock = time;
+ok(($mock >= $TRUE) && ($mock <= $TRUE+1), "Absolute time works");
+sleep 2;
+$mock = time;
+ok(($mock >= $TRUE+2) && ($mock <= $TRUE+3), "Absolute time is still in sync after two seconds sleep:$mock");
+$mock = Time::Local::timelocal(localtime);
+$real = Time::Local::timelocal(CORE::localtime);
+ok($mock <= $real, "localtime seems ok");
+
+# set_absolute_time with an explicit date spec
+Test::MockTime::set_absolute_time('03:25:19 07/30/2006', '%H:%M:%S %m/%d/%Y');
+$mock = time;
+ok(($mock >= $TRUE) && ($mock <= $TRUE+1), "Absolute time with explicit date specworks");
+sleep 2;
+$mock = time;
+ok(($mock >= $TRUE+2) && ($mock <= $TRUE+3), "Absolute time is still in sync after two seconds sleep:$mock");
+$real = Time::Local::timelocal(CORE::localtime);
+ok($mock <= $real, "localtime seems ok");
+
+# try set_fixed_time with a defaulted date spec
+Test::MockTime::set_fixed_time('2006-07-30T03:25:19Z');
+$real = time;
+sleep 2;
+$mock = time;
+cmp_ok($mock, '==', $real, "time is fixed");
+cmp_ok($mock, '==', $TRUE, "time is fixed correctly");
+Test::MockTime::set_fixed_time('2006-07-30T03:25:19Z');
+$mock = Time::Local::timelocal(localtime());
+sleep 2;
+$real = Time::Local::timelocal(localtime);
+cmp_ok($mock, '==', $real, "localtime is fixed");
+cmp_ok($mock, '==', $TRUE, "localtime is fixed correctly");
+Test::MockTime::set_fixed_time('2006-07-30T03:25:19Z');
+$mock = Time::Local::timegm(gmtime);
+sleep 2;
+$real = Time::Local::timegm(gmtime);
+cmp_ok($mock, '==', $real, "gmtime is fixed");
+cmp_ok($mock, '==', $TRUE, "gmtime is fixed correctly");
+
+# try set_fixed_time with an explicit date spec
+Test::MockTime::set_fixed_time('03:25:19 07/30/2006', '%H:%M:%S %m/%d/%Y');
+$real = time;
+sleep 2;
+$mock = time;
+cmp_ok($mock, '==', $real, "time is fixed with explicit date spec");
+cmp_ok($mock, '==', $TRUE, "time is fixed correctly");
+Test::MockTime::set_fixed_time('03:25:19 07/30/2006', '%H:%M:%S %m/%d/%Y');
+$mock = Time::Local::timelocal(localtime());
+sleep 2;
+$real = Time::Local::timelocal(localtime);
+cmp_ok($mock, '==', $real, "localtime is fixed");
+cmp_ok($mock, '==', $TRUE, "localtime is fixed correctly");
+Test::MockTime::set_fixed_time('03:25:19 07/30/2006', '%H:%M:%S %m/%d/%Y');
+$mock = Time::Local::timegm(gmtime);
+sleep 2;
+$real = Time::Local::timegm(gmtime);
+cmp_ok($mock, '==', $real, "gmtime is fixed");
+cmp_ok($mock, '==', $TRUE, "gmtime is fixed correctly");
Added: branches/upstream/libtest-mocktime-perl/current/t/test.t
URL: http://svn.debian.org/wsvn/branches/upstream/libtest-mocktime-perl/current/t/test.t?rev=22453&op=file
==============================================================================
--- branches/upstream/libtest-mocktime-perl/current/t/test.t (added)
+++ branches/upstream/libtest-mocktime-perl/current/t/test.t Sun Jun 29 10:21:51 2008
@@ -1,0 +1,58 @@
+#! /usr/bin/perl
+
+use Test::MockTime();
+use Test::More(tests => 11);
+use Time::Local();
+use strict;
+use warnings;
+
+my ($mock, $real);
+$mock = time;
+$real = CORE::time;
+ok(($mock == $real) || (($mock + 1) == $real) || (($mock - 1) == $real), "Starting time " . localtime($mock)); # previous two statements might go over a second boundary
+Test::MockTime::set_relative_time(-600);
+$mock = time;
+$real = CORE::time;
+sleep 2;
+$mock = time;
+$mock += 600;
+$real = CORE::time;
+ok(($mock == $real) || (($mock + 1) == $real) || (($mock - 1) == $real), "Set time to be 10 minutes ago, slept for two seconds, time was still in sync");
+$mock = Time::Local::timelocal(localtime);
+$real = Time::Local::timelocal(CORE::localtime);
+$mock = $mock + 600;
+ok(($mock == $real) || (($mock + 1) == $real) || (($mock - 1) == $real), "localtime was also still in sync");
+Test::MockTime::set_relative_time(+2);
+$mock = time;
+$real = CORE::time;
+sleep 2;
+$mock = time;
+$real = CORE::time;
+ok($mock >= ($real + 1), "Set time to be 2 seconds in the future, slept for three seconds, time was still in front");
+$mock = Time::Local::timelocal(localtime);
+$real = Time::Local::timelocal(CORE::localtime);
+ok($mock >= ($real + 1), "localtime was also still in front");
+Test::MockTime::set_absolute_time(100);
+$mock = time;
+ok(($mock >= 100) && ($mock <= 101), "Absolute time works");
+sleep 2;
+$mock = time;
+ok(($mock >= 102) && ($mock <= 103), "Absolute time is still in sync after two seconds sleep:$mock");
+$mock = Time::Local::timelocal(localtime);
+$real = Time::Local::timelocal(CORE::localtime);
+ok($mock <= $real, "localtime seems ok");
+Test::MockTime::set_fixed_time(CORE::time);
+$real = time;
+sleep 2;
+$mock = time;
+ok($mock == $real, "fixed time correctly");
+Test::MockTime::set_fixed_time(CORE::time);
+$mock = Time::Local::timelocal(localtime());
+sleep 2;
+$real = Time::Local::timelocal(localtime);
+ok($mock eq $real, "fixed localtime correctly");
+Test::MockTime::set_fixed_time(CORE::time);
+$mock = Time::Local::timegm(gmtime);
+sleep 2;
+$real = Time::Local::timegm(gmtime);
+ok($mock eq $real, "fixed gmtime correctly");
Propchange: branches/upstream/libtest-mocktime-perl/current/t/test.t
------------------------------------------------------------------------------
svn:executable =
More information about the Pkg-perl-cvs-commits
mailing list