1 | #!/usr/bin/perl |
---|
2 | |
---|
3 | use strict; |
---|
4 | use warnings; |
---|
5 | |
---|
6 | use Test::More qw{no_plan}; |
---|
7 | |
---|
8 | main(); |
---|
9 | |
---|
10 | sub 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 |
---|
26 | sub 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 |
---|
45 | sub 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 |
---|
60 | sub 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 |
---|
75 | sub 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 |
---|
90 | sub 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 |
---|
108 | sub 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 |
---|
124 | sub 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 |
---|
140 | sub 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 |
---|
156 | sub 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__ |
---|