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