r2278 - in packages/libtime-piece-perl/branches/upstream/current: .
t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Tue Mar 7 17:31:26 UTC 2006
Author: eloy
Date: 2006-03-07 17:31:25 +0000 (Tue, 07 Mar 2006)
New Revision: 2278
Added:
packages/libtime-piece-perl/branches/upstream/current/._Piece.xs
packages/libtime-piece-perl/branches/upstream/current/META.yml
packages/libtime-piece-perl/branches/upstream/current/t/06subclass.t
Modified:
packages/libtime-piece-perl/branches/upstream/current/Changes
packages/libtime-piece-perl/branches/upstream/current/MANIFEST
packages/libtime-piece-perl/branches/upstream/current/Piece.pm
packages/libtime-piece-perl/branches/upstream/current/Piece.xs
packages/libtime-piece-perl/branches/upstream/current/t/01base.t
packages/libtime-piece-perl/branches/upstream/current/t/02core.t
packages/libtime-piece-perl/branches/upstream/current/t/04mjd.t
Log:
Load /tmp/tmp.cdMdyU/libtime-piece-perl-1.09 into
packages/libtime-piece-perl/branches/upstream/current.
Added: packages/libtime-piece-perl/branches/upstream/current/._Piece.xs
===================================================================
(Binary files differ)
Property changes on: packages/libtime-piece-perl/branches/upstream/current/._Piece.xs
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Modified: packages/libtime-piece-perl/branches/upstream/current/Changes
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/Changes 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/Changes 2006-03-07 17:31:25 UTC (rev 2278)
@@ -1,6 +1,11 @@
Time::Piece Changes
+1.09
+ - (patches from Ricardo SIGNES)
+ - Tests largely moved to Test::More (from Test.pm)
+ - Time::Piece should now be safely subclassable
+
1.08
- A number of fixes for strptime
- Fixed docs wrt Time::Object references
Modified: packages/libtime-piece-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/MANIFEST 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/MANIFEST 2006-03-07 17:31:25 UTC (rev 2278)
@@ -11,3 +11,5 @@
t/03compare.t
t/04mjd.t
t/05overload.t
+t/06subclass.t
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libtime-piece-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/META.yml 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/META.yml 2006-03-07 17:31:25 UTC (rev 2278)
@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Time-Piece
+version: 1.09
+version_from: Piece.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Modified: packages/libtime-piece-perl/branches/upstream/current/Piece.pm
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/Piece.pm 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/Piece.pm 2006-03-07 17:31:25 UTC (rev 2278)
@@ -1,4 +1,4 @@
-# $Id: Piece.pm,v 1.16 2002/12/22 11:17:48 matt Exp $
+# $Id: Piece.pm,v 1.16.2.2 2006/02/11 12:55:26 rjbs Exp $
package Time::Piece;
@@ -23,7 +23,7 @@
':override' => 'internal',
);
-$VERSION = '1.08';
+$VERSION = '1.09';
bootstrap Time::Piece $VERSION;
@@ -48,15 +48,19 @@
use constant 'c_islocal' => 10;
sub localtime {
- my $time = shift;
+ unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
+ my $class = shift;
+ my $time = shift;
$time = time if (!defined $time);
- _mktime($time, 1);
+ $class->_mktime($time, 1);
}
sub gmtime {
- my $time = shift;
+ unshift @_, __PACKAGE__ unless eval { $_[0]->isa('Time::Piece') };
+ my $class = shift;
+ my $time = shift;
$time = time if (!defined $time);
- _mktime($time, 0);
+ $class->_mktime($time, 0);
}
sub new {
@@ -66,13 +70,13 @@
my $self;
if (defined($time)) {
- $self = &localtime($time);
+ $self = $class->localtime($time);
}
elsif (ref($class) && $class->isa(__PACKAGE__)) {
- $self = _mktime($class->epoch, $class->[c_islocal]);
+ $self = $class->_mktime($class->epoch, $class->[c_islocal]);
}
else {
- $self = &localtime();
+ $self = $class->localtime();
}
return bless $self, $class;
@@ -93,18 +97,37 @@
}
sub _mktime {
- my ($time, $islocal) = @_;
+ my ($class, $time, $islocal) = @_;
+ $class = eval { (ref $class)->isa('Time::Piece') } ? ref $class : $class;
if (ref($time)) {
$time->[c_epoch] = undef;
- return wantarray ? @$time : bless [@$time, $islocal], 'Time::Piece';
+ return wantarray ? @$time : bless [@$time, $islocal], $class;
}
+ _tzset();
my @time = $islocal ?
CORE::localtime($time)
:
CORE::gmtime($time);
- wantarray ? @time : bless [@time, $time, $islocal], 'Time::Piece';
+ wantarray ? @time : bless [@time, $time, $islocal], $class;
}
+my %_special_exports = (
+ localtime => sub { my $c = $_[0]; sub { $c->localtime(@_) } },
+ gmtime => sub { my $c = $_[0]; sub { $c->gmtime(@_) } },
+);
+
+sub export {
+ my ($class, $to, @methods) = @_;
+ for my $method (@methods) {
+ if (exists $_special_exports{$method}) {
+ no strict 'refs';
+ *{$to . "::$method"} = $_special_exports{$method}->($class);
+ } else {
+ $class->SUPER::export($to, $method);
+ }
+ }
+}
+
sub import {
# replace CORE::GLOBAL localtime and gmtime if required
my $class = shift;
@@ -332,7 +355,7 @@
sub julian_day {
my $time = shift;
# Correct for localtime
- $time = &gmtime( $time->epoch ) if $time->[c_islocal];
+ $time = $time->gmtime( $time->epoch ) if $time->[c_islocal];
# Calculate the Julian day itself
my $jd = $time->_jd( $time->year, $time->mon, $time->mday,
@@ -441,7 +464,7 @@
my $format = @_ ? shift(@_) : "%a, %d %b %Y %H:%M:%S %Z";
my @vals = _strptime($string, $format);
# warn(sprintf("got vals: %d-%d-%d %d:%d:%d\n", reverse(@vals)));
- return scalar _mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0));
+ return scalar $time->_mktime(\@vals, (ref($time) ? $time->[c_islocal] : 0));
}
sub day_list {
@@ -519,7 +542,7 @@
}
else {
# rhs is seconds.
- return _mktime(($time->epoch - $rhs), $time->[c_islocal]);
+ return $time->_mktime(($time->epoch - $rhs), $time->[c_islocal]);
}
}
@@ -531,7 +554,7 @@
}
croak "Invalid rhs of addition: $rhs" if ref($rhs);
- return _mktime(($time->epoch + $rhs), $time->[c_islocal]);
+ return $time->_mktime(($time->epoch + $rhs), $time->[c_islocal]);
}
use overload
Modified: packages/libtime-piece-perl/branches/upstream/current/Piece.xs
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/Piece.xs 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/Piece.xs 2006-03-07 17:31:25 UTC (rev 2278)
@@ -875,6 +875,12 @@
}
void
+_tzset()
+ PPCODE:
+ tzset();
+
+
+void
_strptime ( string, format )
char * string
char * format
Modified: packages/libtime-piece-perl/branches/upstream/current/t/01base.t
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/t/01base.t 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/t/01base.t 2006-03-07 17:31:25 UTC (rev 2278)
@@ -1,13 +1,19 @@
-use Test;
-BEGIN { plan tests => 4 }
-use Time::Piece;
-ok(1);
+use Test::More tests => 7;
+BEGIN { use_ok('Time::Piece'); }
+
my $t = gmtime(315532800); # 00:00:00 1/1/1980
-ok($t->year == 1980);
+isa_ok($t, 'Time::Piece', 'specific gmtime');
-ok($t->hour, 0);
+cmp_ok($t->year, '==', 1980, 'correct year');
-ok($t->mon, 1);
+cmp_ok($t->hour, '==', 0, 'correct hour');
+cmp_ok($t->mon, '==', 1, 'correct mon');
+
+my $g = gmtime;
+isa_ok($g, 'Time::Piece', 'current gmtime');
+
+my $l = localtime;
+isa_ok($l, 'Time::Piece', 'current localtime');
Modified: packages/libtime-piece-perl/branches/upstream/current/t/02core.t
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/t/02core.t 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/t/02core.t 2006-03-07 17:31:25 UTC (rev 2278)
@@ -1,53 +1,54 @@
-use Test;
-BEGIN { plan tests => 91 }
+use Test::More tests => 93;
+
my $is_win32 = ($^O =~ /Win32/);
-use Time::Piece;
+BEGIN { use_ok('Time::Piece'); }
ok(1);
my $t = gmtime(951827696); # 2000-02-29T12:34:56
-ok($t->sec, 56);
-ok($t->second, 56);
-ok($t->min, 34);
-ok($t->minute, 34);
-ok($t->hour, 12);
-ok($t->mday, 29);
-ok($t->day_of_month, 29);
-ok($t->mon, 2);
-ok($t->_mon, 1);
-ok($t->monname, 'Feb');
-ok($t->month, 'Feb');
-ok($t->fullmonth, 'February');
-ok($t->year, 2000);
-ok($t->_year, 100);
-ok($t->yy, '00');
-ok($t->wday == 3);
-ok($t->_wday == 2);
-ok($t->day_of_week == 2);
-ok($t->wdayname eq 'Tue');
-ok($t->day eq 'Tue');
-ok($t->fullday eq 'Tuesday');
-ok($t->yday == 59);
-ok($t->day_of_year == 59);
+is($t->sec, 56);
+is($t->second, 56);
+is($t->min, 34);
+is($t->minute, 34);
+is($t->hour, 12);
+is($t->mday, 29);
+is($t->day_of_month, 29);
+is($t->mon, 2);
+is($t->_mon, 1);
+is($t->monname, 'Feb');
+is($t->month, 'Feb');
+is($t->fullmonth, 'February');
+is($t->year, 2000);
+is($t->_year, 100);
+is($t->yy, '00');
+cmp_ok($t->wday, '==', 3);
+cmp_ok($t->_wday, '==', 2);
+cmp_ok($t->day_of_week, '==', 2);
+cmp_ok($t->wdayname, 'eq', 'Tue');
+cmp_ok($t->day, 'eq', 'Tue');
+cmp_ok($t->fullday, 'eq', 'Tuesday');
+cmp_ok($t->yday, '==', 59);
+cmp_ok($t->day_of_year, '==', 59);
+
# In GMT there should be no daylight savings ever.
-ok($t->isdst == 0);
-ok($t->daylight_savings == 0);
-ok($t->hms eq '12:34:56');
-ok($t->time eq '12:34:56');
-ok($t->ymd eq '2000-02-29');
-ok($t->date eq '2000-02-29');
-ok($t->mdy eq '02-29-2000');
-ok($t->dmy eq '29-02-2000');
-ok($t->cdate eq 'Tue Feb 29 12:34:56 2000');
-ok("$t" eq 'Tue Feb 29 12:34:56 2000');
-ok($t->datetime eq '2000-02-29T12:34:56');
-ok($t->epoch == 951827696);
+cmp_ok($t->isdst, '==', 0);
+cmp_ok($t->epoch, '==', 951827696);
+cmp_ok($t->hms, 'eq', '12:34:56');
+cmp_ok($t->time, 'eq', '12:34:56');
+cmp_ok($t->ymd, 'eq', '2000-02-29');
+cmp_ok($t->date, 'eq', '2000-02-29');
+cmp_ok($t->mdy, 'eq', '02-29-2000');
+cmp_ok($t->dmy, 'eq', '29-02-2000');
+cmp_ok($t->cdate, 'eq', 'Tue Feb 29 12:34:56 2000');
+cmp_ok("$t", 'eq', 'Tue Feb 29 12:34:56 2000');
+cmp_ok($t->datetime, 'eq','2000-02-29T12:34:56');
+cmp_ok($t->daylight_savings, '==', 0);
# ->tzoffset?
-ok(($t->julian_day / 2451604.0243) - 1 < 0.001);
-ok(($t->mjd / 51603.52426) - 1 < 0.001);
-ok($t->week == 9);
+cmp_ok(($t->julian_day / 2451604.0243 ) - 1, '<', 0.001);
+cmp_ok(($t->mjd / 51603.52426) - 1, '<', 0.001);
+cmp_ok($t->week, '==', 9);
# strftime tests
@@ -56,57 +57,72 @@
# %C is unportable: sometimes its like asctime(3) or date(1),
# sometimes it's the century (and whether for 2000 the century is
# 20 or 19, is fun, too..as far as I can read SUSv2 it should be 20.)
-ok($t->strftime('%d') == 29);
-skip($is_win32, $t->strftime('%D') eq '02/29/00'); # Yech!
-skip($is_win32, $t->strftime('%e') eq '29'); # should test with < 10
-ok($t->strftime('%H') eq '12'); # should test with < 10
+cmp_ok($t->strftime('%d'), '==', 29);
- # %h is locale-dependent
+SKIP: {
+ skip "can't strftime %D, %R, %T or %e on Win32", 2 if $is_win32;
+ cmp_ok($t->strftime('%D'), 'eq', '02/29/00'); # Yech!
+ cmp_ok($t->strftime('%e'), 'eq', '29'); # should test with < 10
+}
-ok($t->strftime('%I') eq '12'); # should test with < 10
-ok($t->strftime('%j') == 60); # why ->yday+1 ?
-ok($t->strftime('%M') eq '34'); # should test with < 10
+# %h is locale-dependent
+cmp_ok($t->strftime('%H'), 'eq', '12'); # should test with < 10
+cmp_ok($t->strftime('%I'), 'eq', '12'); # should test with < 10
+cmp_ok($t->strftime('%j'), '==', 60 ); # why ->yday+1 ?
+cmp_ok($t->strftime('%M'), 'eq', '34'); # should test with < 10
+
# %p, %P, and %r are not widely implemented,
# and are possibly unportable (am or AM or a.m., and so on)
-skip($is_win32, $t->strftime('%R') eq '12:34'); # should test with > 12
+SKIP: {
+ skip "can't strftime %R on Win32", 1 if $is_win32;
+ cmp_ok($t->strftime('%R'), 'eq', '12:34'); # should test with > 12
+}
+
ok($t->strftime('%S') eq '56'); # should test with < 10
-skip($is_win32, $t->strftime('%T') eq '12:34:56'); # < 12 and > 12
+SKIP: {
+ skip "can't strftime %T on Win32", 1 if $is_win32;
+ cmp_ok($t->strftime('%T'), 'eq', '12:34:56'); # < 12 and > 12
+}
+
# There are bugs in the implementation of %u in many platforms.
# (e.g. Linux seems to think, despite the man page, that %u
# 1-based on Sunday...)
-ok($t->strftime('%U') eq '09'); # Sun cmp Mon
-# BROKEN ON OSX: ok($t->strftime('%V') eq '09'); # Sun cmp Mon
-ok($t->strftime('%w') == 2);
-ok($t->strftime('%W') eq '09'); # Sun cmp Mon
+cmp_ok($t->strftime('%U'), 'eq', '09'); # Sun cmp Mon
+# is this test really broken on Mac OS? -- rjbs, 2006-02-08
+cmp_ok($t->strftime('%V'), 'eq', '09'); # Sun cmp Mon
+
+cmp_ok($t->strftime('%w'), '==', 2);
+cmp_ok($t->strftime('%W'), 'eq', '09'); # Sun cmp Mon
+
# %x is locale and implementation dependent.
-ok($t->strftime('%y') == 0); # should test with 1999
-ok($t->strftime('%Y') eq '2000');
+cmp_ok($t->strftime('%y'), '==', 0); # should test with 1999
+cmp_ok($t->strftime('%Y'), 'eq', '2000');
# %Z is locale and implementation dependent
# (there is NO standard for timezone names)
-ok($t->date("") eq '20000229');
-ok($t->ymd("") eq '20000229');
-ok($t->mdy("/") eq '02/29/2000');
-ok($t->dmy(".") eq '29.02.2000');
-ok($t->date_separator() eq '-');
+cmp_ok($t->date(""), 'eq', '20000229');
+cmp_ok($t->ymd("") , 'eq', '20000229');
+cmp_ok($t->mdy("/"), 'eq', '02/29/2000');
+cmp_ok($t->dmy("."), 'eq', '29.02.2000');
+cmp_ok($t->date_separator, 'eq', '-');
$t->date_separator("/");
-ok($t->ymd eq '2000/02/29');
-ok($t->date_separator() eq '/');
+cmp_ok($t->date_separator, 'eq', '/');
+cmp_ok($t->ymd, 'eq', '2000/02/29');
$t->date_separator("-");
-ok($t->hms(".") eq '12.34.56');
-ok($t->time_separator() eq ':');
+cmp_ok($t->time_separator, 'eq', ':');
+cmp_ok($t->hms("."), 'eq', '12.34.56');
$t->time_separator(".");
-ok($t->hms eq '12.34.56');
-ok($t->time_separator() eq '.');
+cmp_ok($t->time_separator, 'eq', '.');
+cmp_ok($t->hms, 'eq', '12.34.56');
$t->time_separator(":");
@@ -114,37 +130,41 @@
perjantai lauantai );
my @frdays = qw( Dimanche Lundi Merdi Mercredi Jeudi Vendredi Samedi );
-ok($t->day(@fidays) eq "tiistai");
+cmp_ok($t->day(@fidays), 'eq', "tiistai");
my @days = $t->day_list();
$t->day_list(@frdays);
-ok($t->day eq "Merdi");
+cmp_ok($t->day, 'eq', "Merdi");
$t->day_list(@days);
-ok($t->day eq "Tue");
+cmp_ok($t->day, 'eq', "Tue");
my @months = $t->mon_list();
my @dumonths = qw(januari februari maart april mei juni
juli augustus september oktober november december);
-ok($t->month(@dumonths) eq "februari");
+cmp_ok($t->month(@dumonths), 'eq', "februari");
$t->mon_list(@dumonths);
-ok($t->month eq "februari");
+cmp_ok($t->month, 'eq', "februari");
$t->mon_list(@months);
-ok($t->month eq "Feb");
+cmp_ok($t->month, 'eq', "Feb");
-ok($t->datetime(date => '/', T => ' ', time => '-') eq "2000/02/29 12-34-56");
+cmp_ok(
+ $t->datetime(date => '/', T => ' ', time => '-'),
+ 'eq',
+ "2000/02/29 12-34-56"
+);
ok($t->is_leap_year); # should test more with different dates
-ok($t->month_last_day == 29); # test more
+cmp_ok($t->month_last_day, '==', 29); # test more
ok(!Time::Piece::_is_leap_year(1900));
@@ -152,23 +172,28 @@
ok(Time::Piece::_is_leap_year(1904));
-ok(Time::Piece->strptime("1945", "%Y")->year, 1945, "Year is 1945?");
+cmp_ok(Time::Piece->strptime("1945", "%Y")->year, '==', 1945, "Year is 1945?");
-ok(Time::Piece->strptime("13:00", "%H:%M")->hour, 13, "Hour is 13?");
+cmp_ok(Time::Piece->strptime("13:00", "%H:%M")->hour, '==', 13, "Hour is 13?");
# Test week number
# [from Ilya Martynov]
-ok(Time::Piece->strptime("2002/06/10 0", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 1", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 2", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 12", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 13", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 14", '%Y/%m/%d %H')->week,24);
-ok(Time::Piece->strptime("2002/06/10 23", '%Y/%m/%d %H')->week,24);
+cmp_ok(Time::Piece->strptime("2002/06/10 0", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 1", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 2", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 12", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 13", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 14", '%Y/%m/%d %H')->week, '==', 24);
+cmp_ok(Time::Piece->strptime("2002/06/10 23", '%Y/%m/%d %H')->week, '==', 24);
# Test that strptime populates all relevant fields
-ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->wday,4);
-ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->day_of_week,3);
-ok(Time::Piece->strptime("2002/12/31", '%Y/%m/%d')->yday,364);
-ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->isdst,0);
-ok(Time::Piece->strptime("2000/02/29 12:34:56", '%Y/%m/%d %H:%M:%S')->epoch,951827696);
+cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->wday, '==', 4);
+cmp_ok(Time::Piece->strptime("2002/12/31", '%Y/%m/%d')->yday, '==', 364);
+cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->isdst, '==', 0);
+cmp_ok(Time::Piece->strptime("2002/07/10", '%Y/%m/%d')->day_of_week, '==', 3);
+
+cmp_ok(
+ Time::Piece->strptime("2000/02/29 12:34:56", '%Y/%m/%d %H:%M:%S')->epoch,
+ '==',
+ 951827696
+);
Modified: packages/libtime-piece-perl/branches/upstream/current/t/04mjd.t
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/t/04mjd.t 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/t/04mjd.t 2006-03-07 17:31:25 UTC (rev 2278)
@@ -12,7 +12,7 @@
951827696 => '51603.524', # 2000-02-29T12:34:56UT
1000011 => '40598.574', # 1970-01-12T13:46:51UT
1021605703 => '52411.140', # 2002-05-17T03:21:43UT
- 1121605703 => '53568.547', # 2005-07-17T13:08:23UT
+ 1121605703 => '53568.547', # 2005-07-17T13:08:23UT
1011590000 => '52295.218', # 2002-01-21T05:13:20UT
1011605703 => '52295.399', # 2002-01-21T09:35:03
);
Added: packages/libtime-piece-perl/branches/upstream/current/t/06subclass.t
===================================================================
--- packages/libtime-piece-perl/branches/upstream/current/t/06subclass.t 2006-03-07 16:33:12 UTC (rev 2277)
+++ packages/libtime-piece-perl/branches/upstream/current/t/06subclass.t 2006-03-07 17:31:25 UTC (rev 2278)
@@ -0,0 +1,47 @@
+#!perl
+use strict;
+use warnings;
+
+# This test file exists to show that Time::Piece can be subclassed and that its
+# methods will return objects of the class on which they're called.
+
+use Test::More 'no_plan';
+
+BEGIN { use_ok('Time::Piece'); }
+
+my $class = 'Time::Piece::Twin';
+
+for my $method (qw(new localtime gmtime)) {
+ my $piece = $class->$method;
+ isa_ok($piece, $class, "timepiece made via $method");
+}
+
+{
+ my $piece = $class->strptime("2005-01-01", "%Y-%m-%d");
+ isa_ok($piece, $class, "timepiece made via strptime");
+}
+
+{
+ my $piece = $class->new;
+ isa_ok($piece, $class, "timepiece made via new (again)");
+
+ my $sum = $piece + 86_400;
+ isa_ok($sum, $class, "tomorrow via addition operator");
+
+ my $diff = $piece - 86_400;
+ isa_ok($diff, $class, "yesterday via subtraction operator");
+}
+
+{
+ # let's verify that we can use gmtime from T::P without the export magic
+ my $piece = Time::Piece::gmtime;
+ isa_ok($piece, "Time::Piece", "object created via full-qualified gmtime");
+ isnt(ref $piece, 'Time::Piece::Twin', "it's not a Twin");
+}
+
+## below is our doppelgaenger package
+{
+ package Time::Piece::Twin;
+ use base qw(Time::Piece);
+ # this package is identical, but will be ->isa('Time::Piece::Twin');
+}
More information about the Pkg-perl-cvs-commits
mailing list