# t/004_croak.t - make sure we croak when we should
use Test::More tests => 30;
use DateTime::Format::Strptime;
# 1..2
my $return;
eval { $return = DateTime::Format::Strptime->new(pattern => '%Y') };
isa_ok($return, 'DateTime::Format::Strptime','Legal Pattern in constructor should return object and not croak');
is($@, '', "Croak message should be empty");
# 3..4
eval { DateTime::Format::Strptime->new(pattern => '%Y %Q') };
isnt($@, undef, "Illegal pattern in constructor should croak");
is(substr($@,0,42), "Unidentified token in pattern: %Q in %Y %Q", "Croak message should reflect illegal pattern");
#--------------------------------------------------------------------------------
#diag("\nTurned Croak Off");
my $object = DateTime::Format::Strptime->new(
pattern => '%Y %D',
time_zone => 'Australia/Melbourne',
locale => 'en_AU',
on_error => 'undef',
diagnostic => 0,
);
# 5..6
is($object->pattern('%Y %D'), '%Y %D','Legal Pattern in pattern() should return the pattern');
is($object->{errmsg} , undef, "Error message should be undef");
# 7..8
is($object->pattern("%Q") , undef, "Illegal Pattern should return undef");
is($object->{errmsg} , 'Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Error message should reflect illegal pattern");
# 9..10
is($object->pattern("%{gumtree}") , undef, "Non-existing DateTime call should return undef");
is($object->{errmsg} , 'Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', "Error message should reflect illegal pattern");
# Make sure pattern goes back to being useful
$object->pattern('%Y %D');
# 11..12
is($object->parse_datetime("Not a datetime") , undef, "Non-matching date time string should return undef");
is($object->{errmsg} , 'Your datetime does not match your pattern.', "Error message should reflect non-matching datetime");
# 13..14
is($object->parse_datetime("2002 11/30/03") , undef, "Ambiguous date time string should return undef");
is($object->{errmsg} , 'Your two year values (03 and 2002) do not match.', "Error message should reflect Ambiguous date time string");
#--------------------------------------------------------------------------------
#diag("\nTurned Croak On");
$object = DateTime::Format::Strptime->new(
pattern => '%Y %D',
time_zone => 'Australia/Melbourne',
locale => 'en_AU',
on_error => 'croak',
diagnostic => 0,
);
{ # Make warn die so $@ is set. There's probably a better way.
local $SIG{__WARN__} = sub { die "WARN: $_[0]" };
eval { $object->pattern("%Q") };
}
# 15..16
isnt($@ , '', "Illegal Pattern should carp");
is(substr($@,0,74), 'WARN: Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Croak message should reflect illegal pattern");
# 17..18
eval { $object->parse_datetime("Not a datetime") };
isnt($@ , '', "Non-matching date time string should croak");
is(substr($@,0,42), "Your datetime does not match your pattern.", "Croak message should reflect non-matching datetime");
# 19..20
eval { $object->parse_datetime("2002 11/30/03") };
isnt($@ , '', "Ambiguous date time string should croak");
is(substr($@,0,48), "Your two year values (03 and 2002) do not match.", "Croak message should reflect Ambiguous date time string");
#--------------------------------------------------------------------------------
#diag("\nTurned Croak to Sub");
$object = DateTime::Format::Strptime->new(
pattern => '%Y %D',
time_zone => 'Australia/Melbourne',
locale => 'en_AU',
on_error => sub{$_[0]->{errmsg} = 'Oops! Teehee! '.$_[1]; 1},
diagnostic => 0,
);
# 21..22
is($object->pattern('%Y %D'), '%Y %D','Legal Pattern in pattern() should return the pattern');
is($object->{errmsg} , undef, "Error message should be undef");
# 23..24
is($object->pattern("%Q") , undef, "Illegal Pattern should return undef");
is($object->{errmsg} , 'Oops! Teehee! Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', "Error message should reflect illegal pattern");
# 25..26
is($object->pattern("%{gumtree}") , undef, "Non-existing DateTime call should return undef");
is($object->{errmsg} , 'Oops! Teehee! Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', "Error message should reflect illegal pattern");
# Make sure pattern goes back to being useful
$object->pattern('%Y %D');
# 27..28
is($object->parse_datetime("Not a datetime") , undef, "Non-matching date time string should return undef");
is($object->{errmsg} , 'Oops! Teehee! Your datetime does not match your pattern.', "Error message should reflect non-matching datetime");
# 29..30
is($object->parse_datetime("2002 11/30/03") , undef, "Ambiguous date time string should return undef");
is($object->{errmsg} , 'Oops! Teehee! Your two year values (03 and 2002) do not match.', "Error message should reflect Ambiguous date time string");