1# t/004_croak.t - make sure we croak when we should 2 3use Test::More 0.88; 4use DateTime::Format::Strptime; 5 6# 1..2 7my $return; 8eval { $return = DateTime::Format::Strptime->new( pattern => '%Y' ) }; 9isa_ok( $return, 'DateTime::Format::Strptime', 10 'Legal Pattern in constructor should return object and not croak' ); 11is( $@, '', "Croak message should be empty" ); 12 13# 3..4 14eval { DateTime::Format::Strptime->new( pattern => '%Y %Q' ) }; 15isnt( $@, undef, "Illegal pattern in constructor should croak" ); 16is( substr( $@, 0, 42 ), "Unidentified token in pattern: %Q in %Y %Q", 17 "Croak message should reflect illegal pattern" ); 18 19#-------------------------------------------------------------------------------- 20 21#diag("\nTurned Croak Off"); 22 23my $object = DateTime::Format::Strptime->new( 24 pattern => '%Y %D', 25 time_zone => 'Australia/Melbourne', 26 locale => 'en_AU', 27 on_error => 'undef', 28 diagnostic => 0, 29); 30 31# 5..6 32is( $object->pattern('%Y %D'), '%Y %D', 33 'Legal Pattern in pattern() should return the pattern' ); 34is( $object->{errmsg}, undef, "Error message should be undef" ); 35 36# 7..8 37is( $object->pattern("%Q"), undef, "Illegal Pattern should return undef" ); 38is( $object->{errmsg}, 39 'Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', 40 "Error message should reflect illegal pattern" ); 41 42# 9..10 43is( $object->pattern("%{gumtree}"), undef, 44 "Non-existing DateTime call should return undef" ); 45is( $object->{errmsg}, 46 'Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', 47 "Error message should reflect illegal pattern" ); 48 49# Make sure pattern goes back to being useful 50$object->pattern('%Y %D'); 51 52# 11..12 53is( $object->parse_datetime("Not a datetime"), undef, 54 "Non-matching date time string should return undef" ); 55is( $object->{errmsg}, 'Your datetime does not match your pattern.', 56 "Error message should reflect non-matching datetime" ); 57 58# 13..14 59is( $object->parse_datetime("2002 11/30/03"), undef, 60 "Ambiguous date time string should return undef" ); 61is( $object->{errmsg}, 'Your two year values (03 and 2002) do not match.', 62 "Error message should reflect Ambiguous date time string" ); 63 64#-------------------------------------------------------------------------------- 65 66#diag("\nTurned Croak On"); 67$object = DateTime::Format::Strptime->new( 68 pattern => '%Y %D', 69 time_zone => 'Australia/Melbourne', 70 locale => 'en_AU', 71 on_error => 'croak', 72 diagnostic => 0, 73); 74 75{ # Make warn die so $@ is set. There's probably a better way. 76 local $SIG{__WARN__} = sub { die "WARN: $_[0]" }; 77 eval { $object->pattern("%Q") }; 78} 79 80# 15..16 81isnt( $@, '', "Illegal Pattern should carp" ); 82is( substr( $@, 0, 74 ), 83 'WARN: Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', 84 "Croak message should reflect illegal pattern" ); 85 86# 17..18 87eval { $object->parse_datetime("Not a datetime") }; 88isnt( $@, '', "Non-matching date time string should croak" ); 89is( substr( $@, 0, 42 ), "Your datetime does not match your pattern.", 90 "Croak message should reflect non-matching datetime" ); 91 92# 19..20 93eval { $object->parse_datetime("2002 11/30/03") }; 94isnt( $@, '', "Ambiguous date time string should croak" ); 95is( substr( $@, 0, 48 ), "Your two year values (03 and 2002) do not match.", 96 "Croak message should reflect Ambiguous date time string" ); 97 98#-------------------------------------------------------------------------------- 99 100#diag("\nTurned Croak to Sub"); 101$object = DateTime::Format::Strptime->new( 102 pattern => '%Y %D', 103 time_zone => 'Australia/Melbourne', 104 locale => 'en_AU', 105 on_error => sub { $_[0]->{errmsg} = 'Oops! Teehee! ' . $_[1]; 1 }, 106 diagnostic => 0, 107); 108 109# 21..22 110is( $object->pattern('%Y %D'), '%Y %D', 111 'Legal Pattern in pattern() should return the pattern' ); 112is( $object->{errmsg}, undef, "Error message should be undef" ); 113 114# 23..24 115is( $object->pattern("%Q"), undef, "Illegal Pattern should return undef" ); 116is( $object->{errmsg}, 117 'Oops! Teehee! Unidentified token in pattern: %Q in %Q. Leaving old pattern intact.', 118 "Error message should reflect illegal pattern" ); 119 120# 25..26 121is( $object->pattern("%{gumtree}"), undef, 122 "Non-existing DateTime call should return undef" ); 123is( $object->{errmsg}, 124 'Oops! Teehee! Unidentified token in pattern: %{gumtree} in %{gumtree}. Leaving old pattern intact.', 125 "Error message should reflect illegal pattern" ); 126 127# Make sure pattern goes back to being useful 128$object->pattern('%Y %D'); 129 130# 27..28 131is( $object->parse_datetime("Not a datetime"), undef, 132 "Non-matching date time string should return undef" ); 133is( $object->{errmsg}, 134 'Oops! Teehee! Your datetime does not match your pattern.', 135 "Error message should reflect non-matching datetime" ); 136 137# 29..30 138is( $object->parse_datetime("2002 11/30/03"), undef, 139 "Ambiguous date time string should return undef" ); 140is( $object->{errmsg}, 141 'Oops! Teehee! Your two year values (03 and 2002) do not match.', 142 "Error message should reflect Ambiguous date time string" ); 143 144done_testing(); 145