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.
Entries.t in branches/UKMO/r6232_INGV1_WAVE-coupling/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword – NEMO

source: branches/UKMO/r6232_INGV1_WAVE-coupling/NEMOGCM/EXTERNAL/fcm/t/Fcm/Keyword/Entries.t @ 7470

Last change on this file since 7470 was 7470, checked in by jcastill, 7 years ago

Remove svn keys

File size: 7.8 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6################################################################################
7# A Fcm::Keyword::Entry sub-class for testing
8{
9    package TestEntry;
10    use base qw{Fcm::Keyword::Entry};
11}
12
13################################################################################
14# A mock loader implementing the Fcm::Keyword::Loader interface
15{
16    package MockLoader0;
17    use Scalar::Util qw{blessed};
18
19    ############################################################################
20    # Constructor
21    sub new {
22        my ($class) = @_;
23        return bless({number_of_calls_to_load_to => 0}, $class);
24    }
25
26    ############################################################################
27    ##Returns the package name
28    sub get_source {
29        my ($self) = @_;
30        return blessed($self);
31    }
32
33    ############################################################################
34    # Returns number of times $self->load_to() has been called
35    sub get_number_of_calls_to_load_to {
36        my ($self) = @_;
37        return $self->{number_of_calls_to_load_to};
38    }
39
40    ############################################################################
41    # Loads data into $entries, and returns number of entries loaded
42    sub load_to {
43        my ($self, $entries) = @_;
44        $self->{number_of_calls_to_load_to}++;
45        return $self->load_to_impl($entries);
46    }
47
48    ############################################################################
49    # Returns 0
50    sub load_to_impl {
51        my ($self, $entries) = @_;
52        return 0;
53    }
54}
55
56################################################################################
57# A mock loader implementing the Fcm::Keyword::Loader interface
58{
59    package MockLoader1;
60    our @ISA = qw{MockLoader0};
61
62    my %VALUE_OF = (foo => 'foo1', bar => 'bar2', baz => 'baz3');
63
64    ############################################################################
65    # Returns a reference to the mock data
66    sub get_data {
67        my ($class) = @_;
68        return \%VALUE_OF;
69    }
70
71    ############################################################################
72    ##Writes mock data to the $entries object
73    sub load_to_impl {
74        my ($self, $entries) = @_;
75        my $counter = 0;
76        for my $key (keys(%{$self->get_data()})) {
77            $entries->add_entry($key, $self->get_data()->{$key});
78            $counter++;
79        }
80        return $counter;
81    }
82}
83
84################################################################################
85# A mock loader implementing the Fcm::Keyword::Loader interface
86{
87    package MockLoader2;
88    our @ISA = qw{MockLoader1};
89
90    my %VALUE_OF = (sausages => 'pig', eggs => 'hen', chips => 'potato');
91
92    ############################################################################
93    # Returns a reference to the mock data
94    sub get_data {
95        my ($class) = @_;
96        return \%VALUE_OF;
97    }
98}
99
100package main;
101
102use Test::More qw{no_plan};
103
104main();
105
106sub main {
107    my $class = 'Fcm::Keyword::Entries';
108    use_ok($class);
109    test_empty_constructor($class);
110    test_constructor($class);
111    test_add_entry($class);
112    test_loaders($class);
113}
114
115################################################################################
116# Tests empty constructor
117sub test_empty_constructor {
118    my ($class) = @_;
119    my $prefix = 'empty constructor';
120    my $entries = $class->new();
121    isa_ok($entries, $class);
122    is($entries->get_entry_class(), 'Fcm::Keyword::Entry',
123        "$prefix: default entry class");
124    is_deeply([$entries->get_loaders()], [], "$prefix: empty list of loaders");
125    is_deeply([$entries->get_all_entries()], [],
126        "$prefix: empty list of entries");
127    for my $arg ('foo', undef) {
128        is($entries->get_entry_by_key($arg), undef,
129            "$prefix: entry by key: undef");
130        is($entries->get_entry_by_value($arg), undef,
131            "$prefix: entry by value: undef");
132    }
133}
134
135################################################################################
136# Tests other constructor usages
137sub test_constructor {
138    my ($class) = @_;
139    my $prefix = 'constructor';
140    my @loaders = (MockLoader1->new(), MockLoader2->new());
141    my $entries = $class->new({
142        entry_class => 'not-a-class',
143        loaders     => \@loaders,
144    });
145    isa_ok($entries, $class);
146    is($entries->get_entry_class(), 'not-a-class', "$prefix: entry class");
147    is_deeply([$entries->get_loaders()], \@loaders, "$prefix: list of loaders");
148    eval {
149        $entries->add_entry('key', 'value');
150    };
151    isnt($@, undef, "$prefix: invalid entry class");
152}
153
154################################################################################
155# Tests adding entries
156sub test_add_entry {
157    my ($class) = @_;
158    my $prefix = 'add entry';
159    my %VALUE_OF = (key1 => 'value1', egg => 'white and yolk', 'xyz.abc' => '');
160    for my $entry_class ('Fcm::Keyword::Entry', 'TestEntry') {
161        my $entries = $class->new({entry_class => $entry_class});
162        my $number_of_entries = 0;
163        for my $key (keys(%VALUE_OF)) {
164            my $entry = $entries->add_entry($key, $VALUE_OF{$key});
165            isa_ok($entry, $entry_class);
166            is(scalar(@{$entries->get_all_entries()}), ++$number_of_entries,
167                "$prefix: number of entries: $number_of_entries");
168        }
169        for my $key (keys(%VALUE_OF)) {
170            my $entry = $entries->get_entry_by_key($key);
171            isa_ok($entry, $entry_class);
172            is($entry->get_key(), uc($key), "$prefix: get by key: $key");
173            is($entry->get_value(), $VALUE_OF{$key},
174                "$prefix: get by key: $key: value");
175        }
176        for my $key (keys(%VALUE_OF)) {
177            my $entry = $entries->get_entry_by_value($VALUE_OF{$key});
178            isa_ok($entry, $entry_class);
179            is($entry->get_key(), uc($key), "$prefix: get by value: $key");
180            is($entry->get_value(), $VALUE_OF{$key},
181                "$prefix: get by value: $key: value");
182        }
183        is($entries->get_entry_by_key('no-such-key'), undef,
184            "$prefix: get by key: no-such-key");
185        is($entries->get_entry_by_value('no-such-value'), undef,
186            "$prefix: get by value: no-such-value");
187    }
188}
189
190################################################################################
191# Tests usage of loaders
192sub test_loaders {
193    my ($class) = @_;
194    my $prefix = "loader";
195    my @loaders = (MockLoader0->new(), MockLoader1->new(), MockLoader2->new());
196    my $entries = $class->new({loaders => \@loaders});
197    for my $loader (@loaders) {
198        is($loader->get_number_of_calls_to_load_to(), 0, "$prefix: not loaded");
199    }
200    for my $key (keys(%{$loaders[1]->get_data()})) {
201        my $value = $loaders[1]->get_data()->{$key};
202        my $entry = $entries->get_entry_by_key($key);
203        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
204        is($entries->get_entry_by_value($value), $entry,
205            "$prefix: by value: $key: object");
206    }
207    is($loaders[0]->get_number_of_calls_to_load_to(), 1,
208        "$prefix: loaded once: 0");
209    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
210        "$prefix: loaded once: 1");
211    is($loaders[2]->get_number_of_calls_to_load_to(), 0,
212        "$prefix: not loaded: 2");
213    for my $key (keys(%{$loaders[2]->get_data()})) {
214        my $value = $loaders[2]->get_data()->{$key};
215        my $entry = $entries->get_entry_by_key($key);
216        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
217        is($entries->get_entry_by_value($value), $entry,
218            "$prefix: by value: $key: object");
219    }
220    is($loaders[0]->get_number_of_calls_to_load_to(), 2,
221        "$prefix: loaded once: 0");
222    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
223        "$prefix: loaded once: 1");
224    is($loaders[2]->get_number_of_calls_to_load_to(), 1,
225        "$prefix: not loaded: 2");
226}
227
228__END__
Note: See TracBrowser for help on using the repository browser.