[1980] | 1 | #!/usr/bin/perl |
---|
| 2 | |
---|
| 3 | use strict; |
---|
| 4 | use warnings; |
---|
| 5 | |
---|
| 6 | use Fcm::CLI::Config::Default; |
---|
| 7 | use Fcm::CLI::Subcommand; |
---|
| 8 | use Test::More qw{no_plan}; |
---|
| 9 | |
---|
| 10 | main(); |
---|
| 11 | |
---|
| 12 | sub main { |
---|
| 13 | my $class = 'Fcm::CLI::Config'; |
---|
| 14 | use_ok($class); |
---|
| 15 | test_get_instance($class); |
---|
| 16 | test_get_subcommand_of_string($class); |
---|
| 17 | } |
---|
| 18 | |
---|
| 19 | ################################################################################ |
---|
| 20 | # Tests normal usage of getting an instance |
---|
| 21 | sub test_get_instance { |
---|
| 22 | my ($class) = @_; |
---|
| 23 | my $prefix = 'constructor'; |
---|
| 24 | my $cli_config = $class->instance(); |
---|
| 25 | isa_ok($cli_config, $class, "$prefix"); |
---|
| 26 | is_deeply( |
---|
| 27 | [$cli_config->get_core_subcommands()], |
---|
| 28 | \@Fcm::CLI::Config::Default::CORE_SUBCOMMANDS, |
---|
| 29 | "$prefix: default core", |
---|
| 30 | ); |
---|
| 31 | is_deeply( |
---|
| 32 | [$cli_config->get_vc_subcommands()], |
---|
| 33 | \@Fcm::CLI::Config::Default::VC_SUBCOMMANDS, |
---|
| 34 | "$prefix: default vc", |
---|
| 35 | ); |
---|
| 36 | is_deeply( |
---|
| 37 | [$cli_config->get_subcommands()], |
---|
| 38 | [$cli_config->get_core_subcommands(), $cli_config->get_vc_subcommands()], |
---|
| 39 | "$prefix: default", |
---|
| 40 | ); |
---|
| 41 | is($class->instance(), $cli_config, "$prefix: same instance"); |
---|
| 42 | isnt($class->instance({}), $cli_config, "$prefix: not the same instance"); |
---|
| 43 | my $empty_cli_config = $class->instance({ |
---|
| 44 | core_subcommands => [], |
---|
| 45 | vc_subcommands => [], |
---|
| 46 | }); |
---|
| 47 | is_deeply( |
---|
| 48 | [$empty_cli_config->get_core_subcommands()], |
---|
| 49 | [], |
---|
| 50 | "$prefix: empty core", |
---|
| 51 | ); |
---|
| 52 | is_deeply( |
---|
| 53 | [$empty_cli_config->get_vc_subcommands()], |
---|
| 54 | [], |
---|
| 55 | "$prefix: empty vc", |
---|
| 56 | ); |
---|
| 57 | is_deeply( |
---|
| 58 | [$empty_cli_config->get_subcommands()], |
---|
| 59 | [], |
---|
| 60 | "$prefix: empty", |
---|
| 61 | ); |
---|
| 62 | } |
---|
| 63 | |
---|
| 64 | ################################################################################ |
---|
| 65 | # Tests getting a subcommand of a matching string |
---|
| 66 | sub test_get_subcommand_of_string { |
---|
| 67 | my ($class) = @_; |
---|
| 68 | my $prefix = 'get_subcommand_of'; |
---|
| 69 | my $foo_subcommand = Fcm::CLI::Subcommand->new({names => ['food', 'foo']}); |
---|
| 70 | my $bar_subcommand = Fcm::CLI::Subcommand->new({names => ['barley', 'bar']}); |
---|
| 71 | my $cli_config = $class->instance({ |
---|
| 72 | core_subcommands => [$foo_subcommand, $bar_subcommand], |
---|
| 73 | vc_subcommands => [], |
---|
| 74 | }); |
---|
| 75 | for my $key ('food', 'foo') { |
---|
| 76 | is($cli_config->get_subcommand_of($key), $foo_subcommand, |
---|
| 77 | "$prefix: $key"); |
---|
| 78 | } |
---|
| 79 | for my $key ('barley', 'bar') { |
---|
| 80 | is($cli_config->get_subcommand_of($key), $bar_subcommand, |
---|
| 81 | "$prefix: $key"); |
---|
| 82 | } |
---|
| 83 | is($cli_config->get_subcommand_of('baz'), undef, "$prefix: baz"); |
---|
| 84 | } |
---|
| 85 | |
---|
| 86 | __END__ |
---|