[1980] | 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__ |
---|