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

source: branches/UKMO/dev_r5518_flux_adjust/NEMOGCM/EXTERNAL/fcm/t/Fcm/ConfigSystem.t @ 5880

Last change on this file since 5880 was 5880, checked in by timgraham, 8 years ago

Clear svn keywords

File size: 4.9 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# (C) Crown copyright Met Office. All rights reserved.
4# For further details please refer to the file COPYRIGHT.txt
5# which you should have received as part of this distribution.
6# ------------------------------------------------------------------------------
7
8use strict;
9use warnings;
10
11use Fcm::CfgLine;
12use Fcm::Config;
13use Scalar::Util qw{reftype};
14use Test::More (tests => 90);
15
16BEGIN: {
17    use_ok('Fcm::ConfigSystem');
18}
19
20my $CONFIG = undef;
21
22# ------------------------------------------------------------------------------
23if (!caller()) {
24    main(@ARGV);
25}
26
27# ------------------------------------------------------------------------------
28sub main {
29    local @ARGV = @_;
30    test_compare_setting_in_config();
31}
32
33# ------------------------------------------------------------------------------
34# Tests "compare_setting_in_config".
35sub test_compare_setting_in_config {
36    my $PREFIX = 'TEST';
37    my %S = (egg => [qw{boiled poached}], ham => 'roasted', bacon => 'fried');
38    my %S_MOD = (ham => 'boiled');
39    my %S_MOD_ARRAY = (egg => [qw{scrambled omelette}]);
40    my %S_ADD = (mushroom => 'sauteed');
41    my %S_DEL = (bacon => undef);
42
43    my @ITEMS = (
44        {
45            name     => 'empty',
46            original => {},
47            added    => {},
48            removed  => {},
49            modified => {},
50        },
51        {
52            name     => 'add keys to empty',
53            original => {},
54            added    => {%S},
55            removed  => {},
56            modified => {%S},
57        },
58        {
59            name     => 'remove all',
60            original => {%S},
61            added    => {},
62            removed  => {},
63            modified => {map {($_, undef)} keys(%S)},
64        },
65        {
66            name     => 'no change',
67            original => {%S},
68            added    => {%S},
69            removed  => {},
70            modified => {},
71        },
72        {
73            name     => 'modify key',
74            original => {%S},
75            added    => {%S, %S_MOD},
76            removed  => {},
77            modified => {%S_MOD},
78        },
79        {
80            name     => 'modify an array key',
81            original => {%S},
82            added    => {%S, %S_MOD_ARRAY},
83            removed  => {},
84            modified => {%S_MOD_ARRAY},
85        },
86        {
87            name     => 'add a key',
88            original => {%S},
89            added    => {%S, %S_ADD},
90            removed  => {},
91            modified => {%S_ADD},
92        },
93        {
94            name     => 'delete a key',
95            original => {%S},
96            added    => {%S},
97            removed  => {%S_DEL},
98            modified => {%S_DEL},
99        },
100        {
101            name     => 'modify a key and delete a key',
102            original => {%S},
103            added    => {%S, %S_MOD},
104            removed  => {%S_DEL},
105            modified => {%S_MOD, %S_DEL},
106        },
107        {
108            name     => 'add a key and delete a key',
109            original => {%S},
110            added    => {%S, %S_ADD},
111            removed  => {%S_DEL},
112            modified => {%S_ADD, %S_DEL},
113        },
114    );
115
116    # A naive function to serialise an array reference
117    my $flatten = sub {
118        if (ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
119            join(q{ }, sort(@{$_[0]}))
120        }
121        else {
122            $_[0];
123        }
124    };
125
126    my $CONFIG = Fcm::Config->instance();
127    for my $item (@ITEMS) {
128        # New settings
129        $CONFIG->{setting}{$PREFIX} = {%{$item->{added}}};
130        for my $key (keys(%{$item->{removed}})) {
131            delete($CONFIG->{setting}{$PREFIX}{$key});
132        }
133
134        # Old lines
135        my @old_lines = map {
136            Fcm::CfgLine->new(
137                LABEL => $PREFIX . $Fcm::Config::DELIMITER . $_,
138                VALUE => $flatten->($item->{original}{$_}),
139            )
140        } keys(%{$item->{original}});
141
142        # Invokes the method
143        my $system = Fcm::ConfigSystem->new();
144        my ($changed_hash_ref, $new_cfg_lines_ref)
145            = $system->compare_setting_in_config($PREFIX, \@old_lines);
146
147        # Tests the return values
148        my $T = $item->{name};
149        is_deeply(
150            $changed_hash_ref, $item->{modified},
151            "$T: \$changed_hash_ref content",
152        );
153        is(
154            scalar(@{$new_cfg_lines_ref}),
155            scalar(keys(%{$item->{added}})) - scalar(keys(%{$item->{removed}})),
156            "$T: \$new_cfg_lines_ref length",
157        );
158        for my $line (@{$new_cfg_lines_ref}) {
159            my $key = $line->label_from_field(1);
160            ok(exists($item->{added}{$key}), "$T: expected label $key");
161            ok(!exists($item->{removed}{$key}), "$T: unexpected label $key");
162            is(
163                $line->value(), $flatten->($item->{added}{$key}),
164                "$T: line content $key",
165            );
166        }
167    }
168}
169
170__END__
Note: See TracBrowser for help on using the repository browser.