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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
# -*- cperl -*-
use ExtUtils::testlib;
use Test::More ;
use Tk;
use Config::Model::TkUI;
use Config::Model ;
use Config::Model::Tester::Setup qw/init_test setup_test_dir/;
use Config::Model::Value ;
use Test::Memory::Cycle;
use strict;
use warnings;
use lib 't/lib';
my ($model, $trace, $args) = init_test('show');
note("You can play with the widget if you run the test with '--show' option");
my $wr_root = setup_test_dir;
my $inst = $model->instance (
root_class_name => 'Master',
instance_name => 'test1',
root_dir => $wr_root,
);
ok($inst,"created dummy instance") ;
my $root = $inst -> config_root ;
ok($root,"Config root created") ;
$Config::Model::Value::nowarning=1;
my $step = qq!
warn_unless=qwerty
std_id:ab X=Bv -
std_id:ab2 -
std_id:bc X=Av -
std_id:"a b" X=Av -
std_id:"a b.c" X=Av -
tree_macro=mXY
a_string="toto tata"
a_long_string="a very long string with\nembedded return"
hash_a:toto=toto_value
hash_a:titi=titi_value
hash_a:"ti ti"="ti ti value"
ordered_hash:z=1
ordered_hash:y=2
ordered_hash:x=3
ordered_hash_of_nodes:N1 X=Av -
ordered_hash_of_nodes:N2 X=Bv -
lista=a,b,c,d
olist:0 X=Av -
olist:1 X=Bv -
my_ref_check_list=toto
my_reference="titi"
my_plain_check_list=AA,AC
warp warp2 aa2="foo bar"
!;
ok( $root->load( step => $step ), "set up data in tree");
# use Tk::ObjScanner; Tk::ObjScanner::scan_object($root) ;
# TBD eval this and skip test in case of failure.
SKIP: {
my $mw = eval {MainWindow-> new ; };
# cannot create Tk window
skip "Cannot create Tk window",1 if $@;
$mw->withdraw ;
my $cmw = $mw->ConfigModelWizard (-root => $root,
-store_cb => sub{},
) ;
unless ($args->{show}) {
my $delay = 1000 ;
sub inc_d { $delay += 800 } ;
my @test ;
foreach (1 .. 4 ) {
push @test, sub {
$cmw->{keep_wiz_editor} = 0 ;
$cmw->{wizard}->go_forward;
ok(1,"Going forward");
} ;
}
foreach (1 .. 2 ) {
push @test, sub {
$cmw->{keep_wiz_editor} = 0 ;
$cmw->{wizard}->go_backward;
ok(1,"Going backward");
} ;
}
# no problem if too many subs are defined: programs will exit
foreach (1 .. 10 ) {
push @test, sub {
$cmw->{keep_wiz_editor} = 0 ;
$cmw->{wizard}->go_forward;
ok(1,"Going forward");
} ;
}
foreach my $t (@test) {
$mw->after($delay, $t);
inc_d ;
}
}
$cmw->start_wizard() ;
ok(1,"wizard done") ;
memory_cycle_ok($cmw, "memory cycle");
}
done_testing;
|
