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

source: branches/UKMO/dev_r5518_rnf_fix/NEMOGCM/EXTERNAL/fcm/t/Fcm/Interactive.t @ 7800

Last change on this file since 7800 was 7800, checked in by frrh, 7 years ago

Strip out svn keywords and properties

File size: 2.9 KB
Line 
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6################################################################################
7# A sub-class of Fcm::Interactive::InputGetter for testing
8{
9    package TestInputGetter;
10    use base qw{Fcm::Interactive::InputGetter};
11
12    ############################################################################
13    # A callback for testing
14    sub get_callback {
15        my ($self) = @_;
16        return $self->{callback};
17    }
18
19    ############################################################################
20    # Returns some pre-defined strings
21    sub invoke {
22        my ($self) = @_;
23        $self->get_callback()->(
24            $self->get_title(),
25            $self->get_message(),
26            $self->get_type(),
27            $self->get_default(),
28        );
29        return 'answer';
30    }
31}
32
33use Test::More qw{no_plan};
34
35main();
36
37sub main {
38    use_ok('Fcm::Interactive');
39    test_default_impl();
40    test_set_impl();
41    test_get_input();
42}
43
44################################################################################
45# Tests default setting of input getter implementation
46sub test_default_impl {
47    my $prefix = 'default impl';
48    my ($class_name, $class_options_ref) = Fcm::Interactive::get_default_impl();
49    is($class_name, 'Fcm::Interactive::InputGetter::CLI', "$prefix: class name");
50    is_deeply($class_options_ref, {}, "$prefix: class options");
51}
52
53################################################################################
54# Tests setting the input getter implementation
55sub test_set_impl {
56    my $prefix = 'set impl';
57    my %options = (extra => 'extra-value');
58    my $name = 'TestInputGetter';
59    Fcm::Interactive::set_impl($name, \%options);
60    my ($class_name, $class_options_ref) = Fcm::Interactive::get_impl();
61    is($class_name, $name, "$prefix: class name");
62    is_deeply($class_options_ref, \%options, "$prefix: class options");
63}
64
65################################################################################
66# Tests getting input with test input getter
67sub test_get_input {
68    my $prefix = 'get input';
69    my %EXPECTED = (
70        TITLE   => 'title-value',
71        MESSAGE => 'message-value',
72        TYPE    => 'type-value',
73        DEFAULT => 'default-value',
74        ANSWER  => 'answer',
75    );
76    Fcm::Interactive::set_impl('TestInputGetter', {
77        callback => sub {
78            my ($title, $message, $type, $default) = @_;
79            is($title, $EXPECTED{TITLE}, "$prefix: title");
80            is($message, $EXPECTED{MESSAGE}, "$prefix: message");
81            is($type, $EXPECTED{TYPE}, "$prefix: type");
82            is($default, $EXPECTED{DEFAULT}, "$prefix: default");
83        },
84    });
85    my $ans = Fcm::Interactive::get_input(
86        title   => $EXPECTED{TITLE},
87        message => $EXPECTED{MESSAGE},
88        type    => $EXPECTED{TYPE},
89        default => $EXPECTED{DEFAULT},
90    );
91    is($ans, $EXPECTED{ANSWER}, "$prefix: answer");
92}
93
94__END__
Note: See TracBrowser for help on using the repository browser.