New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
CLI.t in branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/EXTERNAL/fcm/t/Fcm – NEMO

source: branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI.t @ 5422

Last change on this file since 5422 was 5422, checked in by deazer, 9 years ago

Pre removal of svn keywords

File size: 7.5 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6
7################################################################################
8# A sub-class of Fcm::CLI::Invoker for testing
9{
10    package TestInvoker;
11    use base qw{Fcm::CLI::Invoker};
12
13    our $LATEST_INSTANCE;
14
15    ############################################################################
16    # Returns a test attrib
17    sub get_test_attrib {
18        my ($self) = @_;
19        return $self->{test_attrib};
20    }
21
22    ############################################################################
23    # Invokes the sub-system
24    sub invoke {
25        my ($self) = @_;
26        $LATEST_INSTANCE = $self;
27    }
28}
29
30use Fcm::CLI::Config;
31use Fcm::CLI::Subcommand;
32use Test::More (tests => 25);
33
34main();
35
36sub main {
37    use_ok('Fcm::CLI');
38    test_invalid_subcommand();
39    test_invoker_not_implemented();
40    test_normal_invoke();
41    test_help_invoke();
42    test_get_invoker_normal();
43    test_load_invoker_class();
44}
45
46################################################################################
47# Tests to ensure that an invalid subcommand results in an exception
48sub test_invalid_subcommand {
49    Fcm::CLI::Config->instance({core_subcommands => [], vc_subcommands => []});
50    eval {
51        local(@ARGV) = ('foo');
52        Fcm::CLI::invoke();
53    };
54    like($@, qr{foo: unknown command}, 'invalid subcommand');
55}
56
57################################################################################
58# Tests to ensure that an unimplemented invoker results in an exception
59sub test_invoker_not_implemented {
60    Fcm::CLI::Config->instance({
61        core_subcommands => [
62            Fcm::CLI::Subcommand->new({names => ['foo']}),
63            Fcm::CLI::Subcommand->new({
64                names => ['bar'], invoker_class => 'barley',
65            }),
66        ],
67        vc_subcommands   => [],
68    });
69    eval {
70        local(@ARGV) = ('foo');
71        Fcm::CLI::invoke();
72    };
73    like($@, qr{foo: \s command \s not \s implemented}xms, 'not implemented');
74    eval {
75        local(@ARGV) = ('bar');
76        Fcm::CLI::invoke();
77    };
78    like($@, qr{barley: \s class \s loading \s failed}xms, 'not implemented');
79}
80
81################################################################################
82# Tests normal usage of invoke
83sub test_normal_invoke {
84    my $prefix = "normal invoke";
85    Fcm::CLI::Config->instance({
86        core_subcommands => [
87            Fcm::CLI::Subcommand->new({
88                names          => ['foo'],
89                invoker_class  => 'TestInvoker',
90                invoker_config => {test_attrib => 'test_attrib value'},
91            }),
92        ],
93        vc_subcommands   => [],
94    });
95    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
96    local(@ARGV) = ('foo', 'bar', 'baz');
97    Fcm::CLI::invoke();
98    my $invoker = $TestInvoker::LATEST_INSTANCE;
99    if (!$invoker) {
100        fail($prefix);
101    }
102    else {
103        is($invoker->get_command(), 'foo', "$prefix: invoker command");
104        is_deeply({$invoker->get_options()}, {}, "$prefix: invoker options");
105        is_deeply([$invoker->get_arguments()], ['bar', 'baz'],
106            "$prefix: invoker arguments");
107        is($invoker->get_test_attrib(), 'test_attrib value',
108            "$prefix: invoker test attrib");
109    }
110    $TestInvoker::LATEST_INSTANCE = undef;
111}
112
113################################################################################
114# Tests help usage of invoke
115sub test_help_invoke {
116    my $prefix = "help invoke";
117    Fcm::CLI::Config->instance({
118        core_subcommands => [
119            Fcm::CLI::Subcommand->new({
120                names          => ['foo'],
121                invoker_class  => 'TestInvoker',
122                invoker_config => {test_attrib => 'test_attrib value normal'},
123                options        => [
124                    Fcm::CLI::Option->new({name => 'foo', is_help => 1}),
125                ],
126            }),
127            Fcm::CLI::Subcommand->new({
128                names          => [q{}],
129                invoker_class  => 'TestInvoker',
130            }),
131        ],
132        vc_subcommands   => [],
133    });
134    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
135    local(@ARGV) = ('foo', '--foo');
136    Fcm::CLI::invoke();
137    my $invoker = $TestInvoker::LATEST_INSTANCE;
138    if (!$invoker) {
139        fail($prefix);
140    }
141    else {
142        is_deeply([$invoker->get_arguments()], ['foo'],
143            "$prefix: invoker argument");
144    }
145    $TestInvoker::LATEST_INSTANCE = undef;
146}
147
148################################################################################
149# Tests getting an invoker
150sub test_get_invoker_normal {
151    my $prefix = 'get invoker normal';
152    my @options = (
153        Fcm::CLI::Option->new({name => 'foo'}),
154        Fcm::CLI::Option->new({name => 'bar'}),
155        Fcm::CLI::Option->new({name => 'baz'}),
156        Fcm::CLI::Option->new({
157            name      => q{pork},
158            delimiter => q{,},
159            has_arg   => Fcm::CLI::Option->ARRAY_ARG,
160        }),
161    );
162    my $subcommand = Fcm::CLI::Subcommand->new({options => \@options});
163    my %TEST = (
164        test1 => {
165            argv      => ['--foo', '--bar', 'egg', 'ham', 'sausage'],
166            command   => 'command',
167            options   => {foo => 1, bar => 1},
168            arguments => ['egg', 'ham', 'sausage'],
169        },
170        test2 => {
171            argv      => ['--baz', '--foo', '--bar'],
172            command   => 'test',
173            options   => {foo => 1, bar => 1, baz => 1},
174            arguments => [],
175        },
176        test3 => {
177            argv      => ['egg', 'ham', 'sausage'],
178            command   => 'meal',
179            options   => {},
180            arguments => ['egg', 'ham', 'sausage'],
181        },
182        test4 => {
183            argv      => ['--pork', 'ham', '--pork', 'sausage'],
184            command   => 'pig',
185            options   => {pork => ['ham', 'sausage']},
186            arguments => [],
187        },
188        test5 => {
189            argv      => ['--pork', 'ham,sausage', '--pork', 'bacon', 'liver'],
190            command   => 'pig',
191            options   => {pork => ['ham', 'sausage', 'bacon']},
192            arguments => ['liver'],
193        },
194    );
195    for my $key (keys(%TEST)) {
196        local(@ARGV) = @{$TEST{$key}{argv}};
197        my ($opts_ref, $args_ref) = Fcm::CLI::_parse_argv_using($subcommand);
198        is_deeply($opts_ref, $TEST{$key}{options},
199            "$prefix $key: get options");
200        is_deeply($args_ref, $TEST{$key}{arguments},
201            "$prefix $key: get arguments");
202    }
203    my %BAD_TEST = (
204        test1 => {
205            argv => ['--egg', '--bar', 'foo', 'ham', 'sausage'],
206        },
207        test2 => {
208            argv => ['--foo=egg'],
209        },
210    );
211    for my $key (keys(%BAD_TEST)) {
212        local(@ARGV) = @{$BAD_TEST{$key}{argv}};
213        eval {
214            Fcm::CLI::_parse_argv_using($subcommand);
215        };
216        isa_ok($@, 'Fcm::CLI::Exception', "$prefix $key");
217    }
218}
219
220################################################################################
221# Tests loading an invoker with a different class
222sub test_load_invoker_class {
223    my $prefix = 'get invoker class';
224    eval {
225        my $subcommand = Fcm::CLI::Subcommand->new({invoker_class => 'foo'});
226        Fcm::CLI::_load_invoker_class_of($subcommand);
227    };
228    isa_ok($@, 'Fcm::Exception', "$prefix");
229
230    my $invoker_class = 'Fcm::CLI::Invoker::ConfigSystem';
231    my $subcommand
232        = Fcm::CLI::Subcommand->new({invoker_class => $invoker_class});
233    my $class = Fcm::CLI::_load_invoker_class_of($subcommand);
234    is($class, $invoker_class, "$prefix: $invoker_class");
235}
236
237__END__
Note: See TracBrowser for help on using the repository browser.