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

source: branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/EXTERNAL/fcm/t/Fcm/CLI/Option.t @ 8730

Last change on this file since 8730 was 8730, checked in by dancopsey, 6 years ago

Cleared out SVN keywords.

File size: 5.7 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6use Test::More qw{no_plan};
7
8main();
9
10sub main {
11    my $class = 'Fcm::CLI::Option';
12    use_ok($class);
13    test_simplest($class);
14    test_simplest_scalar_arg($class);
15    test_simplest_array_arg($class);
16    test_simplest_hash_arg($class);
17    test_simple($class);
18    test_simple_scalar_arg($class);
19    test_simple_array_arg($class);
20    test_simple_hash_arg($class);
21    test_long_letter($class);
22}
23
24################################################################################
25# Tests simplest usage
26sub test_simplest {
27    my ($class) = @_;
28    my $prefix = 'simplest';
29    my $option = $class->new({
30        delimiter   => 'delimiter-value',
31        description => 'description value',
32        name        => 'name-value',
33    });
34    isa_ok($option, $class);
35    is($option->get_delimiter(), 'delimiter-value', "$prefix: delimiter");
36    is($option->get_description(), 'description value', "$prefix: description");
37    is($option->get_name(), 'name-value', "$prefix: name");
38    is($option->get_letter(), undef, "$prefix: letter");
39    ok(!$option->has_arg(), "$prefix: has arg");
40    is($option->get_arg_for_getopt_long(), 'name-value', "$prefix: has arg");
41}
42
43################################################################################
44# Tests simplest usage with a scalar argument
45sub test_simplest_scalar_arg {
46    my ($class) = @_;
47    my $prefix = 'simplest scalar arg';
48    my $option = $class->new({
49        description => 'description value',
50        name        => 'name-value',
51        has_arg     => $class->SCALAR_ARG,
52    });
53    isa_ok($option, $class);
54    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
55    is($option->get_arg_for_getopt_long(), 'name-value=s', "$prefix: has arg");
56}
57
58################################################################################
59# Tests simplest usage with array argument
60sub test_simplest_array_arg {
61    my ($class) = @_;
62    my $prefix = 'simplest array arg';
63    my $option = $class->new({
64        description => 'description value',
65        name        => 'name-value',
66        has_arg     => $class->ARRAY_ARG,
67    });
68    isa_ok($option, $class);
69    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
70    is($option->get_arg_for_getopt_long(), 'name-value=s@', "$prefix: has arg");
71}
72
73################################################################################
74# Tests simplest usage with hash argument
75sub test_simplest_hash_arg {
76    my ($class) = @_;
77    my $prefix = 'simplest hash arg';
78    my $option = $class->new({
79        description => 'description value',
80        name        => 'name-value',
81        has_arg     => $class->HASH_ARG,
82    });
83    isa_ok($option, $class);
84    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
85    is($option->get_arg_for_getopt_long(), 'name-value=s%', "$prefix: has arg");
86}
87
88################################################################################
89# Tests simple usage
90sub test_simple {
91    my ($class) = @_;
92    my $prefix = 'simple';
93    my $option = $class->new({
94        description => 'description value',
95        name        => 'name-value',
96        letter      => 'n',
97    });
98    isa_ok($option, $class);
99    is($option->get_description(), 'description value', "$prefix: description");
100    is($option->get_name(), 'name-value', "$prefix: name");
101    is($option->get_letter(), 'n', "$prefix: letter");
102    is($option->has_arg(), $class->NO_ARG, "$prefix: has arg");
103    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
104}
105
106################################################################################
107# Tests simple usage with a scalar argument
108sub test_simple_scalar_arg {
109    my ($class) = @_;
110    my $prefix = 'simple scalar arg';
111    my $option = $class->new({
112        description => 'description value',
113        name        => 'name-value',
114        letter      => 'n',
115        has_arg     => $class->SCALAR_ARG,
116    });
117    isa_ok($option, $class);
118    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
119    is($option->get_arg_for_getopt_long(), 'name-value|n=s', "$prefix: has arg");
120}
121
122################################################################################
123# Tests simplest usage with array argument
124sub test_simple_array_arg {
125    my ($class) = @_;
126    my $prefix = 'simple array arg';
127    my $option = $class->new({
128        description => 'description value',
129        name        => 'name-value',
130        letter      => 'n',
131        has_arg     => $class->ARRAY_ARG,
132    });
133    isa_ok($option, $class);
134    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
135    is($option->get_arg_for_getopt_long(), 'name-value|n=s@', "$prefix: has arg");
136}
137
138################################################################################
139# Tests simplest usage with hash argument
140sub test_simple_hash_arg {
141    my ($class) = @_;
142    my $prefix = 'simple hash arg';
143    my $option = $class->new({
144        description => 'description value',
145        name        => 'name-value',
146        letter      => 'n',
147        has_arg     => $class->HASH_ARG,
148    });
149    isa_ok($option, $class);
150    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
151    is($option->get_arg_for_getopt_long(), 'name-value|n=s%', "$prefix: has arg");
152}
153
154################################################################################
155# Tests longer than 1 letter
156sub test_long_letter {
157    my ($class) = @_;
158    my $prefix = 'long letter';
159    my $option = $class->new({
160        name   => 'name-value',
161        letter => 'name',
162    });
163    isa_ok($option, $class);
164    is($option->get_letter(), 'n', "$prefix: letter");
165    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
166}
167
168__END__
Note: See TracBrowser for help on using the repository browser.