File: term_ui.t

package info (click to toggle)
libconfig-model-perl 2.155-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,172 kB
  • sloc: perl: 15,117; makefile: 19
file content (107 lines) | stat: -rw-r--r-- 3,181 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
# -*- cperl -*-
use strict;
use warnings;

use ExtUtils::testlib;
use Test::More;
use Test::Differences;

# this block is necessary to avoid failure on some automatic cpan
# testers setup which fail while loading Term::ReadLine
BEGIN {
    my $ok = eval {
        require Term::ReadLine;
        1;
    }
        and (
            eval { require Term::ReadLine::Gnu; 1; }
            or eval { require Term::ReadLine::Perl; 1; }
        );

    if ($ok) {
        plan tests => 18;
    }
    else {
        plan skip_all => "Cannot load Term::ReadLine";
    }
}

use Test::Memory::Cycle;
use Config::Model;
use Config::Model::Tester::Setup qw/init_test/;
use Config::Model::TermUI;

use warnings;
use strict;
use lib "t/lib";

use Data::Dumper;

my ($model, $trace, $args) = init_test('interactive');

note("you can run the test in interactive mode by passing '--interactive' option, e.g. perl -Ilib t/term_ui.t --interactive");

my $inst = $model->instance(
    root_class_name => 'Master',
    instance_name   => 'test1'
);
ok( $inst, "created dummy instance" );

my $root = $inst->config_root;

my $step =
      'std_id:ab X=Bv - '
    . 'std_id:bc X=Av - '
    . 'std_id:"abc def" X=Av - '
    . 'std_id:"abc hij" X=Av - '
    . 'a_string="toto tata"';

ok( $root->load( step => $step ), "set up data in tree with '$step'" );

# this test test only execution of user command, not their actual
# input
my $prompt = 'Test Prompt';

my $term_ui = Config::Model::TermUI->new(
    root   => $root,
    title  => 'Test Title',
    prompt => $prompt,
);

if ($args->{interactive}) {
    $term_ui->run_loop;
    exit;
}

my @std_id_list = ('std_id:','std_id:ab','std_id:"abc def"' ,'std_id:"abc hij"', 'std_id:bc') ;
my @test = (    # text line start ## expected completions
    [
        [ '', '', 0 ],
        [qw/cd changes check clear delete desc description display dump fix help info ll ls reset save set tree/]
    ],
    [ [ '', 'cd ', 3 ], [ '!', '-', @std_id_list , 'olist:', 'warp','slave_y' ] ],
    [ [ 's', 'cd s', 3 ], [  @std_id_list, 'slave_y' ] ],
    [ [ 'sl', 'cd sl',       3 ],  ['slave_y'] ],
    [ [ 'std_id:',   'cd std_id:',  10 ], \@std_id_list ],
    [ [ 'std_id:"',   'cd std_id:"', 11 ], ['std_id:"abc def"' ,'std_id:"abc hij"'  ] ],

    [ [ 'std_id:"abc', 'cd std_id:"abc',14 ], ['std_id:"abc def"' ,'std_id:"abc hij"' ] ],
    [ [ 'std_id:a', 'cd std_id:a', 3 ], ['std_id:ab'] ],
    [ [ '', 'fix ', 4 ], [ $root->get_element_names(), '!'] ],
    [ [ '','tree ', 5], ['std_id:ab', 'std_id:"abc def"', 'std_id:"abc hij"', 'std_id:bc', 'warp', 'slave_y'] ],
    [ [ 'std', 'tree std', 5 ], ['std_id:ab', 'std_id:"abc def"', 'std_id:"abc hij"', 'std_id:bc'] ],
    [ [ 'std', 'ls std', 3], ['std_id:', 'std_id:ab', 'std_id:"abc def"', 'std_id:"abc hij"', 'std_id:bc'] ],
    [ [ 'std_id:ab', 'ls std_id:ab', 3], [ ] ],
    [ [ '', 'info std_id:ab ', 15], ['Z', 'X', 'DX']],
);

foreach my $a_test (@test) {
    my ( $input, $expect ) = @$a_test;

    my @comp = $term_ui->completion(@$input);
    print Dumper ( \@comp ) if $trace;
    eq_or_diff( \@comp, $expect, "exec '" . join( "', '", @$input ) . "'" );

}
memory_cycle_ok($model, "memory cycles");