source: branches/UKMO/r6232_tracer_advection/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Config.t @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

File size: 2.5 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Fcm::CLI::Config::Default;
7use Fcm::CLI::Subcommand;
8use Test::More qw{no_plan};
9
10main();
11
12sub 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
21sub 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
66sub 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__
Note: See TracBrowser for help on using the repository browser.