# 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");