git.maemo.org Git - pkg-perl/blob - deb-src/libperl-critic-perl/libperl-critic-perl-1.088/t/14_policy_parameter_behavior_list_string.t

   1 #!perl
   2
   3 ##############################################################################
   4 #      $URL: http://perlcritic.tigris.org/svn/perlcritic/trunk/Perl-Critic/t/14_policy_parameter_behavior_list_string.t $
   5 #     $Date: 2008-06-06 00:48:04 -0500 (Fri, 06 Jun 2008) $
   6 #   $Author: clonezone $
   7 # $Revision: 2416 $
   8 ##############################################################################
   9
  10 use 5.006001;
  11 use strict;
  12 use warnings;
  13
  14 use Test::More tests => 28;
  15 use English qw(-no_match_vars);
  16
  17 use Perl::Critic::Policy;
  18 use Perl::Critic::PolicyParameter;
  19
  20 my $specification;
  21 my $parameter;
  22 my %config;
  23 my $policy;
  24 my $values;
  25
  26 $specification =
  27     {
  28         name        => 'test',
  29         description => 'A string list parameter for testing',
  30         behavior    => 'string list',
  31     };
  32
  33
  34 $parameter = Perl::Critic::PolicyParameter->new($specification);
  35 $policy = Perl::Critic::Policy->new();
  36 $parameter->parse_and_validate_config_value($policy, \%config);
  37 $values = $policy->{_test};
  38 is( scalar( keys %{$values} ), 0, q{no value, no default} );
  39
  40 $policy = Perl::Critic::Policy->new();
  41 $config{test} = 'koyaanisqatsi';
  42 $parameter->parse_and_validate_config_value($policy, \%config);
  43 $values = $policy->{_test};
  44 is( scalar( keys %{$values} ), 1, q{'koyaanisqatsi', no default} );
  45 ok( $values->{koyaanisqatsi}, q{'koyaanisqatsi', no default} );
  46
  47 $policy = Perl::Critic::Policy->new();
  48 $config{test} = 'powaqqatsi naqoyqatsi';
  49 $parameter->parse_and_validate_config_value($policy, \%config);
  50 $values = $policy->{_test};
  51 is( scalar( keys %{$values} ), 2, q{'powaqqatsi naqoyqatsi', no default} );
  52 ok( $values->{powaqqatsi}, q{'powaqqatsi naqoyqatsi', no default} );
  53 ok( $values->{naqoyqatsi}, q{'powaqqatsi naqoyqatsi', no default} );
  54
  55
  56 $specification->{default_string} = 'baraka chronos';
  57 delete $config{test};
  58
  59 $parameter = Perl::Critic::PolicyParameter->new($specification);
  60 $policy = Perl::Critic::Policy->new();
  61 $parameter->parse_and_validate_config_value($policy, \%config);
  62 $values = $policy->{_test};
  63 is( scalar( keys %{$values} ), 2, q{no value, default 'baraka chronos'} );
  64 ok( $values->{baraka}, q{no value, default 'baraka chronos'} );
  65 ok( $values->{chronos}, q{no value, default 'baraka chronos'} );
  66
  67 $policy = Perl::Critic::Policy->new();
  68 $config{test} = 'akira';
  69 $parameter->parse_and_validate_config_value($policy, \%config);
  70 $values = $policy->{_test};
  71 is( scalar( keys %{$values} ), 1, q{'akira', default 'baraka chronos'} );
  72 ok( $values->{akira}, q{'akira', default 'baraka chronos'} );
  73
  74 $policy = Perl::Critic::Policy->new();
  75 $config{test} = 'downfall murderball';
  76 $parameter->parse_and_validate_config_value($policy, \%config);
  77 $values = $policy->{_test};
  78 is( scalar( keys %{$values} ), 2, q{'downfall murderball', default 'baraka chronos'} );
  79 ok( $values->{downfall}, q{'downfall murderball', default 'baraka chronos'} );
  80 ok( $values->{murderball}, q{'downfall murderball', default 'baraka chronos'} );
  81
  82
  83 $specification->{default_string} = 'chainsuck snog';
  84 $specification->{list_always_present_values} =
  85     [ 'leaether strip', 'front line assembly' ];
  86 delete $config{test};
  87
  88 $parameter = Perl::Critic::PolicyParameter->new($specification);
  89 $policy = Perl::Critic::Policy->new();
  90 $parameter->parse_and_validate_config_value($policy, \%config);
  91 $values = $policy->{_test};
  92 is(
  93     scalar( keys %{$values} ),
  94     4,
  95     q{no value, default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
  96 );
  97 ok(
  98     $values->{chainsuck},
  99     q{no value, default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 100 );
 101 ok(
 102     $values->{snog},
 103     q{no value, default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 104 );
 105 ok(
 106     $values->{'leaether strip'},
 107     q{no value, default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 108 );
 109 ok(
 110     $values->{'front line assembly'},
 111     q{no value, default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 112 );
 113
 114 $policy = Perl::Critic::Policy->new();
 115 $config{test} = 'pig';
 116 $parameter->parse_and_validate_config_value($policy, \%config);
 117 $values = $policy->{_test};
 118 is(
 119     scalar( keys %{$values} ),
 120     3,
 121     q{'pig', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 122 );
 123 ok(
 124     $values->{pig},
 125     q{'pig', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 126 );
 127 ok(
 128     $values->{'leaether strip'},
 129     q{'pig', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 130 );
 131 ok(
 132     $values->{'front line assembly'},
 133     q{'pig', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 134 );
 135
 136 $policy = Perl::Critic::Policy->new();
 137 $config{test} = 'microdisney foetus';
 138 $parameter->parse_and_validate_config_value($policy, \%config);
 139 $values = $policy->{_test};
 140 is(
 141     scalar( keys %{$values} ),
 142     4,
 143     q{'microdisney foetus', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 144 );
 145 ok(
 146     $values->{microdisney},
 147     q{'microdisney foetus', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 148 );
 149 ok(
 150     $values->{foetus},
 151     q{'microdisney foetus', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 152 );
 153 ok(
 154     $values->{'leaether strip'},
 155     q{'microdisney foetus', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 156 );
 157 ok(
 158     $values->{'front line assembly'},
 159     q{'microdisney foetus', default 'chainsuck snog', always 'leaether strip' & 'front line assembly'}
 160 );
 161
 162 ###############################################################################
 163 # Local Variables:
 164 #   mode: cperl
 165 #   cperl-indent-level: 4
 166 #   fill-column: 78
 167 #   indent-tabs-mode: nil
 168 #   c-indentation-style: bsd
 169 # End:
 170 # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :