[1980] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | use Carp qw{croak}; |
---|
| 7 | use Fcm::Keyword::Config; |
---|
| 8 | use Test::More (tests => 227); |
---|
| 9 | |
---|
| 10 | BEGIN: { |
---|
| 11 | use_ok('Fcm::Keyword'); |
---|
| 12 | } |
---|
| 13 | |
---|
| 14 | if (!caller()) { |
---|
| 15 | main(@ARGV); |
---|
| 16 | } |
---|
| 17 | |
---|
| 18 | sub main { |
---|
| 19 | local @ARGV = @_; |
---|
| 20 | local %Fcm::Keyword::Config::CONFIG_OF = ( |
---|
| 21 | LOCATION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry::Location'}, |
---|
| 22 | REVISION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry'}, |
---|
| 23 | ); |
---|
| 24 | test_get_prefix_of_location_keyword(); |
---|
| 25 | test_get_entries(); |
---|
| 26 | test_expand(); |
---|
| 27 | test_unexpand(); |
---|
| 28 | test_get_browser_url(); |
---|
| 29 | } |
---|
| 30 | |
---|
| 31 | ################################################################################ |
---|
| 32 | # Tests get_prefix_of_location_keyword(). |
---|
| 33 | sub test_get_prefix_of_location_keyword { |
---|
| 34 | is(Fcm::Keyword::get_prefix_of_location_keyword(), 'fcm'); |
---|
| 35 | is(Fcm::Keyword::get_prefix_of_location_keyword(1), 'fcm:'); |
---|
| 36 | } |
---|
| 37 | |
---|
| 38 | ################################################################################ |
---|
| 39 | # Tests get_entries(). |
---|
| 40 | sub test_get_entries { |
---|
| 41 | my $entries = Fcm::Keyword::get_entries(); |
---|
| 42 | isa_ok($entries, 'Fcm::Keyword::Entries'); |
---|
| 43 | for (1 .. 10) { |
---|
| 44 | is(Fcm::Keyword::get_entries(), $entries, "get_entries: is singleton"); |
---|
| 45 | } |
---|
| 46 | isnt(Fcm::Keyword::get_entries(1), $entries, "get_entries: can reset"); |
---|
| 47 | } |
---|
| 48 | |
---|
| 49 | ################################################################################ |
---|
| 50 | # Tests expand(). |
---|
| 51 | sub test_expand { |
---|
| 52 | my $T = 'expand'; |
---|
| 53 | |
---|
| 54 | # Add some keywords for testing |
---|
| 55 | _add_keyword_entries([ |
---|
| 56 | # ['name' , 'value' , {'rev1' => rev, ...}], |
---|
| 57 | ['FOO' , 'test://foo/foo' , {'V1.0' => 256, 'V1-1' => 4790}], |
---|
| 58 | ['FOO-TR', 'test://foo/foo/trunk', {}], |
---|
| 59 | ]); |
---|
| 60 | |
---|
| 61 | _do_keyword_tests($T, \&Fcm::Keyword::expand, [ |
---|
| 62 | # Tests to ensure that valid targets are expanded |
---|
| 63 | # [['input' ], ['expected' ]], |
---|
| 64 | [['fcm:FOO' ], ['test://foo/foo' ]], |
---|
| 65 | [['fcm:FOO' , 'V1.0'], ['test://foo/foo' , '256' ]], |
---|
| 66 | [['fcm:Foo' ], ['test://foo/foo' ]], |
---|
| 67 | [['fcm:foo' ], ['test://foo/foo' ]], |
---|
| 68 | [['fcm:foo' , 'v1.0'], ['test://foo/foo' , '256' ]], |
---|
| 69 | [['fcm:foo' , 'head'], ['test://foo/foo' , 'head']], |
---|
| 70 | [['fcm:foo/' ], ['test://foo/foo/' ]], |
---|
| 71 | [['fcm:foo/' , '1234'], ['test://foo/foo/' , '1234']], |
---|
| 72 | [['fcm:foo/' , 'v1.0'], ['test://foo/foo/' , '256' ]], |
---|
| 73 | [['fcm:foo/' , 'v1-1'], ['test://foo/foo/' , '4790']], |
---|
| 74 | [['fcm:foo/bar' ], ['test://foo/foo/bar' ]], |
---|
| 75 | [['fcm:foo/bar' , 'PREV'], ['test://foo/foo/bar' , 'PREV']], |
---|
| 76 | [['fcm:foo/bar' , 'base'], ['test://foo/foo/bar' , 'base']], |
---|
| 77 | [['fcm:foo/bar' , 'v1-1'], ['test://foo/foo/bar' , '4790']], |
---|
| 78 | [['fcm:foo/bar/', '7777'], ['test://foo/foo/bar/' , '7777']], |
---|
| 79 | [['fcm:foo/bar/', '{11}'], ['test://foo/foo/bar/' , '{11}']], |
---|
| 80 | [['fcm:foo/bar/', 'v1.0'], ['test://foo/foo/bar/' , '256' ]], |
---|
| 81 | [['fcm:foo-tr' ], ['test://foo/foo/trunk' ]], |
---|
| 82 | [['fcm:foo-tr' , 'head'], ['test://foo/foo/trunk' , 'head']], |
---|
| 83 | [['fcm:foo-tr' , 'v1.0'], ['test://foo/foo/trunk' , '256' ]], |
---|
| 84 | [['fcm:foo-tr/' ], ['test://foo/foo/trunk/' ]], |
---|
| 85 | [['fcm:foo-tr/' , '1234'], ['test://foo/foo/trunk/', '1234']], |
---|
| 86 | [['fcm:foo-tr/' , 'v1-1'], ['test://foo/foo/trunk/', '4790']], |
---|
| 87 | # Tests to ensure that non-keyword targets are not expanded |
---|
| 88 | # [['input' ]], # 'expected' same as 'input' |
---|
| 89 | [['no-change' ]], |
---|
| 90 | [['foo/bar' ]], |
---|
| 91 | [['/foo/bar' ]], |
---|
| 92 | [['/foo/bar' , 'head' ]], |
---|
| 93 | [['/foo/bar/' ]], |
---|
| 94 | [['/foo/bar/' , 'not-a-key']], |
---|
| 95 | [['svn://foo/bar' ]], |
---|
| 96 | [['svn://foo/bar', '1234' ]], |
---|
| 97 | [['file://foo/bar' ]], |
---|
| 98 | [['http://foo/bar' ]], |
---|
| 99 | ]); |
---|
| 100 | |
---|
| 101 | # Tests for unexpected keywords |
---|
| 102 | for my $key (qw{foo bar baz}) { |
---|
| 103 | eval { |
---|
| 104 | Fcm::Keyword::expand("fcm:foo\@$key"); |
---|
| 105 | }; |
---|
| 106 | isa_ok($@, 'Fcm::Keyword::Exception', "$T: $key: invalid revision"); |
---|
| 107 | } |
---|
| 108 | |
---|
| 109 | # Tests for "undef", all expecting exceptions |
---|
| 110 | for my $target_ref ([undef], [undef, undef], [undef, 'foo']) { |
---|
| 111 | eval { |
---|
| 112 | Fcm::Keyword::expand(@{$target_ref}); |
---|
| 113 | }; |
---|
| 114 | isa_ok($@, 'Fcm::Exception', "$T: undef"); |
---|
| 115 | } |
---|
| 116 | } |
---|
| 117 | |
---|
| 118 | ################################################################################ |
---|
| 119 | # Tests unexpand(). |
---|
| 120 | sub test_unexpand { |
---|
| 121 | my $T = 'unexpand'; |
---|
| 122 | |
---|
| 123 | # Add some keywords for testing |
---|
| 124 | _add_keyword_entries([ |
---|
| 125 | # ['name' , 'value' , {'rev1' => rev, ...}], |
---|
| 126 | ['FOO' , 'test://foo/foo' , {'V1.0' => 256, 'V1-1' => 4790}], |
---|
| 127 | ['FOO_TR', 'test://foo/foo/trunk', {}], |
---|
| 128 | ['FOO-TR', 'test://foo/foo/trunk', {}], |
---|
| 129 | ]); |
---|
| 130 | |
---|
| 131 | _do_keyword_tests($T, \&Fcm::Keyword::unexpand, [ |
---|
| 132 | # Tests to ensure that valid targets are expanded |
---|
| 133 | # [['input' ], ['expected' ]], |
---|
| 134 | [['test://foo/foo' ], ['fcm:FOO' ]], |
---|
| 135 | [['test://foo/foo' , '256' ], ['fcm:FOO' , 'V1.0']], |
---|
| 136 | [['test://foo/foo' , 'head'], ['fcm:FOO' , 'head']], |
---|
| 137 | [['test://foo/foo/' ], ['fcm:FOO/' ]], |
---|
| 138 | [['test://foo/foo/' , '1234'], ['fcm:FOO/' , '1234']], |
---|
| 139 | [['test://foo/foo/' , '256' ], ['fcm:FOO/' , 'V1.0']], |
---|
| 140 | [['test://foo/foo/' , '4790'], ['fcm:FOO/' , 'V1-1']], |
---|
| 141 | [['test://foo/foo/bar' ], ['fcm:FOO/bar' ]], |
---|
| 142 | [['test://foo/foo/bar' , 'PREV'], ['fcm:FOO/bar' , 'PREV']], |
---|
| 143 | [['test://foo/foo/bar' , 'base'], ['fcm:FOO/bar' , 'base']], |
---|
| 144 | [['test://foo/foo/bar' , '4790'], ['fcm:FOO/bar' , 'V1-1']], |
---|
| 145 | [['test://foo/foo/bar/' , '7777'], ['fcm:FOO/bar/', '7777']], |
---|
| 146 | [['test://foo/foo/bar/' , '{11}'], ['fcm:FOO/bar/', '{11}']], |
---|
| 147 | [['test://foo/foo/bar/' , '256' ], ['fcm:FOO/bar/', 'V1.0']], |
---|
| 148 | [['test://foo/foo/trunk' ], ['fcm:FOO-TR' ]], |
---|
| 149 | [['test://foo/foo/trunk' , 'head'], ['fcm:FOO-TR' , 'head']], |
---|
| 150 | [['test://foo/foo/trunk' , '256' ], ['fcm:FOO-TR' , 'V1.0']], |
---|
| 151 | [['test://foo/foo/trunk/' ], ['fcm:FOO-TR/' ]], |
---|
| 152 | [['test://foo/foo/trunk/', '1234'], ['fcm:FOO-TR/' , '1234']], |
---|
| 153 | [['test://foo/foo/trunk/', '4790'], ['fcm:FOO-TR/' , 'V1-1']], |
---|
| 154 | # Tests to ensure that non-keyword targets are not expanded |
---|
| 155 | # [['input' ]], # 'expected' same as 'input' |
---|
| 156 | [['no-change' ]], |
---|
| 157 | [['foo/bar' ]], |
---|
| 158 | [['/foo/bar' ]], |
---|
| 159 | [['/foo/bar' , 'head' ]], |
---|
| 160 | [['/foo/bar/' ]], |
---|
| 161 | [['/foo/bar/' , 'not-a-key']], |
---|
| 162 | [['svn://foo/bar' ]], |
---|
| 163 | [['svn://foo/bar', '1234' ]], |
---|
| 164 | [['file://foo/bar' ]], |
---|
| 165 | [['http://foo/bar' ]], |
---|
| 166 | ]); |
---|
| 167 | |
---|
| 168 | # Tests for "undef", all expecting exceptions |
---|
| 169 | for my $target_ref ([undef], [undef, undef], [undef, 'foo']) { |
---|
| 170 | eval { |
---|
| 171 | Fcm::Keyword::unexpand(@{$target_ref}); |
---|
| 172 | }; |
---|
| 173 | isa_ok($@, 'Fcm::Exception', "$T: undef"); |
---|
| 174 | } |
---|
| 175 | } |
---|
| 176 | |
---|
| 177 | ################################################################################ |
---|
| 178 | # Tests get_browser_url(). |
---|
| 179 | sub test_get_browser_url { |
---|
| 180 | my $T = 'get_browser_url'; |
---|
| 181 | |
---|
| 182 | # Add some keywords for testing |
---|
| 183 | _add_keyword_entries([ |
---|
| 184 | # ['name' , 'value' , {'rev1' => rev, ...}], |
---|
| 185 | ['FOO' , 'test://foo/foo_svn/foo' , {'V1' => 256, 'W2' => 479}], |
---|
| 186 | ['FOO-TR', 'test://foo/foo_svn/foo/trunk'], |
---|
| 187 | ['FOO_TR', 'test://foo/foo_svn/foo/trunk'], |
---|
| 188 | ]); |
---|
| 189 | |
---|
| 190 | my ($INPUT, $EXPECTED) = (0, 1); |
---|
| 191 | my ($LOC, $REV) = (0, 1); |
---|
| 192 | for my $test_ref ( |
---|
| 193 | # Tests to ensure that valid targets are expanded |
---|
| 194 | # [['input' ], 'expected' ], |
---|
| 195 | [['test://foo/foo_svn/foo' ], 'http://foo/projects/foo/intertrac/source:foo' ], |
---|
| 196 | [['test://foo/foo_svn/foo' , '256' ], 'http://foo/projects/foo/intertrac/source:foo@256' ], |
---|
| 197 | [['test://foo/foo_svn/foo' , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head' ], |
---|
| 198 | [['test://foo/foo_svn/foo/' ], 'http://foo/projects/foo/intertrac/source:foo/' ], |
---|
| 199 | [['test://foo/foo_svn/foo/' , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234' ], |
---|
| 200 | [['test://foo/foo_svn/foo/' , '256' ], 'http://foo/projects/foo/intertrac/source:foo/@256' ], |
---|
| 201 | [['test://foo/foo_svn/foo/' , '479' ], 'http://foo/projects/foo/intertrac/source:foo/@479' ], |
---|
| 202 | [['test://foo/foo_svn/foo/bar' ], 'http://foo/projects/foo/intertrac/source:foo/bar' ], |
---|
| 203 | [['test://foo/foo_svn/foo/bar' , '479' ], 'http://foo/projects/foo/intertrac/source:foo/bar@479' ], |
---|
| 204 | [['test://foo/foo_svn/foo/bar/' , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777' ], |
---|
| 205 | [['test://foo/foo_svn/foo/bar/' , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}' ], |
---|
| 206 | [['test://foo/foo_svn/foo/bar/' , '256' ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256' ], |
---|
| 207 | [['test://foo/foo_svn/foo/trunk' ], 'http://foo/projects/foo/intertrac/source:foo/trunk' ], |
---|
| 208 | [['test://foo/foo_svn/foo/trunk' , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ], |
---|
| 209 | [['test://foo/foo_svn/foo/trunk' , '256' ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256' ], |
---|
| 210 | [['test://foo/foo_svn/foo/trunk/' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/' ], |
---|
| 211 | [['test://foo/foo_svn/foo/trunk/', '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'], |
---|
| 212 | [['test://foo/foo_svn/foo/trunk/', '479' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ], |
---|
| 213 | [['fcm:FOO' ], 'http://foo/projects/foo/intertrac/source:foo' ], |
---|
| 214 | [['fcm:FOO' , 'V1' ], 'http://foo/projects/foo/intertrac/source:foo@256' ], |
---|
| 215 | [['fcm:FOO' , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head' ], |
---|
| 216 | [['fcm:FOO/' ], 'http://foo/projects/foo/intertrac/source:foo/' ], |
---|
| 217 | [['fcm:FOO/' , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234' ], |
---|
| 218 | [['fcm:FOO/' , 'V1' ], 'http://foo/projects/foo/intertrac/source:foo/@256' ], |
---|
| 219 | [['fcm:FOO/' , 'W2' ], 'http://foo/projects/foo/intertrac/source:foo/@479' ], |
---|
| 220 | [['fcm:FOO/bar' ], 'http://foo/projects/foo/intertrac/source:foo/bar' ], |
---|
| 221 | [['fcm:FOO/bar' , 'W2' ], 'http://foo/projects/foo/intertrac/source:foo/bar@479' ], |
---|
| 222 | [['fcm:FOO/bar/' , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777' ], |
---|
| 223 | [['fcm:FOO/bar/' , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}' ], |
---|
| 224 | [['fcm:FOO/bar/' , 'v1' ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256' ], |
---|
| 225 | [['fcm:FOO-TR' ], 'http://foo/projects/foo/intertrac/source:foo/trunk' ], |
---|
| 226 | [['fcm:FOO-TR' , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ], |
---|
| 227 | [['fcm:FOO-TR' , 'V1' ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256' ], |
---|
| 228 | [['fcm:FOO-TR/' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/' ], |
---|
| 229 | [['fcm:FOO-TR/' , '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'], |
---|
| 230 | [['fcm:FOO-TR/' , 'w2' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ], |
---|
| 231 | ) { |
---|
| 232 | my $input = $test_ref->[$INPUT][$LOC]; |
---|
| 233 | if (exists($test_ref->[$INPUT][$REV])) { |
---|
| 234 | $input .= '@' . $test_ref->[$INPUT][$REV]; |
---|
| 235 | } |
---|
| 236 | for ( |
---|
| 237 | {name => "$T: scalar input: $input", input => [$input]}, |
---|
| 238 | {name => "$T: list input: $input" , input => $test_ref->[$INPUT]}, |
---|
| 239 | ) { |
---|
| 240 | my $output; |
---|
| 241 | eval { |
---|
| 242 | $output = Fcm::Keyword::get_browser_url(@{$_->{input}}); |
---|
| 243 | is($output, $test_ref->[$EXPECTED], $_->{name}); |
---|
| 244 | }; |
---|
| 245 | if ($@) { |
---|
| 246 | fail("$_->{name}: $@"); |
---|
| 247 | } |
---|
| 248 | } |
---|
| 249 | } |
---|
| 250 | |
---|
| 251 | # Tests correct behaviour for "undef" |
---|
| 252 | for my $bad_url (undef, '') { |
---|
| 253 | eval { |
---|
| 254 | Fcm::Keyword::get_browser_url($bad_url); |
---|
| 255 | }; |
---|
| 256 | isa_ok($@, 'Fcm::Exception', sprintf( |
---|
| 257 | "$T: %s", (defined($bad_url) ? $bad_url : 'undef'), |
---|
| 258 | )); |
---|
| 259 | } |
---|
| 260 | |
---|
| 261 | # Tests correct behaviour for invalid inputs |
---|
| 262 | for my $bad_url ('foo', 'svn://no/such/url', 'fcm:no_such_project/trunk') { |
---|
| 263 | eval { |
---|
| 264 | Fcm::Keyword::get_browser_url($bad_url); |
---|
| 265 | }; |
---|
| 266 | isa_ok($@, 'Fcm::Keyword::Exception', "$T: $bad_url: invalid keyword"); |
---|
| 267 | } |
---|
| 268 | } |
---|
| 269 | |
---|
| 270 | ################################################################################ |
---|
| 271 | # Adds keyword entries. |
---|
| 272 | sub _add_keyword_entries { |
---|
| 273 | my ($items_ref) = @_; |
---|
| 274 | my ($NAME, $LOC, $REV) = (0 .. 2); |
---|
| 275 | my $entries = Fcm::Keyword::get_entries(1); # reset |
---|
| 276 | for my $item_ref (@{$items_ref}) { |
---|
| 277 | my $entry = $entries->add_entry($item_ref->[$NAME], $item_ref->[$LOC]); |
---|
| 278 | while (my ($key, $value) = each(%{$item_ref->[$REV]})) { |
---|
| 279 | $entry->get_revision_entries()->add_entry($key, $value); |
---|
| 280 | } |
---|
| 281 | } |
---|
| 282 | } |
---|
| 283 | |
---|
| 284 | ################################################################################ |
---|
| 285 | # Performs keyword testings. |
---|
| 286 | sub _do_keyword_tests { |
---|
| 287 | my ($T, $action_ref, $tests_ref) = @_; |
---|
| 288 | my ($INPUT, $EXPECTED) = (0, 1); |
---|
| 289 | my ($LOC, $REV) = (0, 1); |
---|
| 290 | for my $test_ref (@{$tests_ref}) { |
---|
| 291 | if (!defined($test_ref->[$EXPECTED])) { |
---|
| 292 | $test_ref->[$EXPECTED] = $test_ref->[$INPUT]; |
---|
| 293 | } |
---|
| 294 | my %value_of; |
---|
| 295 | for my $i (0 .. $#{$test_ref}) { |
---|
| 296 | $value_of{$i} = $test_ref->[$i][$LOC]; |
---|
| 297 | if (exists($test_ref->[$i][$REV])) { |
---|
| 298 | $value_of{$i} .= '@' . $test_ref->[$i][$REV]; |
---|
| 299 | } |
---|
| 300 | } |
---|
| 301 | eval { |
---|
| 302 | is( |
---|
| 303 | $action_ref->($value_of{$INPUT}), $value_of{$EXPECTED}, |
---|
| 304 | "$T: scalar context: $value_of{$INPUT}", |
---|
| 305 | ); |
---|
| 306 | }; |
---|
| 307 | if ($@) { |
---|
| 308 | fail("$T: scalar context: $value_of{$INPUT}: $@"); |
---|
| 309 | } |
---|
| 310 | eval { |
---|
| 311 | is_deeply( |
---|
| 312 | [$action_ref->(@{$test_ref->[$INPUT]})], |
---|
| 313 | $test_ref->[$EXPECTED], |
---|
| 314 | "$T: list context: $value_of{$INPUT}", |
---|
| 315 | ); |
---|
| 316 | }; |
---|
| 317 | if ($@) { |
---|
| 318 | fail("$T: list context: $value_of{$INPUT}: $@"); |
---|
| 319 | } |
---|
| 320 | } |
---|
| 321 | } |
---|
| 322 | |
---|
| 323 | __END__ |
---|