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.
Subcommand.t in branches/UKMO/dev_r5518_area_calc/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI – NEMO

source: branches/UKMO/dev_r5518_area_calc/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Subcommand.t @ 6740

Last change on this file since 6740 was 6740, checked in by jrioual, 8 years ago

Remove svn keywords

File size: 2.1 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Fcm::CLI::Option;
7use Test::More qw{no_plan};
8
9main();
10
11sub main {
12    my $class = 'Fcm::CLI::Subcommand';
13    use_ok($class);
14    test_constructor($class);
15    test_has_a_name($class);
16    test_as_string($class);
17}
18
19################################################################################
20# Tests the constructor
21sub test_constructor {
22    my ($class) = @_;
23    my $prefix = 'constructor';
24    my %OPTION_OF = (
25        description    => 'description value',
26        invoker_class  => 'invoker_class value',
27        invoker_config => 'invoker_config value',
28        is_vc          => 'is_vc value',
29        names          => 'names value',
30        options        => 'options value',
31        synopsis       => 'synopsis value',
32        usage          => 'usage value',
33    );
34    my $subcommand = Fcm::CLI::Subcommand->new(\%OPTION_OF);
35    isa_ok($subcommand, $class, $prefix);
36    for my $key (keys(%OPTION_OF)) {
37        my $getter = index($key, 'is') == 0 ? $key : "get_$key";
38        is($subcommand->$getter(), $OPTION_OF{$key}, "$prefix: $getter");
39    }
40}
41
42################################################################################
43# Tests match a string name to a subcommand
44sub test_has_a_name {
45    my ($class) = @_;
46    my $prefix = 'has a name';
47    my @NAMES = ('foo', 'bar', 'baz');
48    my $subcommand = $class->new({names => \@NAMES});
49    for my $name (@NAMES) {
50        ok($subcommand->has_a_name($name), "$prefix: $name");
51    }
52    for my $name (qw{egg ham mayo}) {
53        ok(!$subcommand->has_a_name($name), "$prefix: $name");
54    }
55}
56
57################################################################################
58# Tests string representation of a subcommand
59sub test_as_string {
60    my ($class) = @_;
61    my $prefix = 'as string';
62    my %OPTION_OF = (
63        'foo (bar, baz)' => ['foo', 'bar', 'baz'],
64        'foo (bar)'      => ['foo', 'bar'],
65        'foo'            => ['foo'],
66        q{}              => [],
67    );
68    for my $key (keys(%OPTION_OF)) {
69        my $subcommand = $class->new({names => $OPTION_OF{$key}});
70        is($subcommand->as_string(), $key, "$prefix: $key");
71    }
72}
73
74__END__
Note: See TracBrowser for help on using the repository browser.