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
|
use strict ;
use warnings ;
use Data::TreeDumper ;
use Test::Exception ;
use Test::Warn;
use Test::NoWarnings qw(had_no_warnings);
use Test::More 'no_plan';
use Test::Block qw($Plan);
use Eval::Context ;
{
local $Plan = {'new arguments' => 7} ;
lives_ok
{
my @parameters = map {$_ => 1}
qw(
NAME
PRE_CODE
POST_CODE
PERL_EVAL_CONTEXT
PACKAGE
DISPLAY_SOURCE_IN_CONTEXT
FILE LINE
) ;
push @parameters, 'INTERACTION', {} ;
my $context = new Eval::Context(@parameters) ;
} 'accepts all defined arguments' ;
lives_ok
{
my $context = new Eval::Context(NAME => '') ;
$context->eval(CODE => '') ;
is($context->{NAME}, 'Anonymous eval context', 'empty name is makes object anonymous') ;
} 'empty name' ;
lives_ok
{
my $context = new Eval::Context(NAME => undef) ;
$context->eval(CODE => '') ;
is($context->{NAME}, 'Anonymous eval context', 'undefined name is makes object anonymous') ;
} 'undefined name' ;
throws_ok
{
my $context = new Eval::Context(1) ;
} qr/Invalid number of argument/, 'invalid number of parameters' ;
throws_ok
{
my $context = new Eval::Context(SOMETHING_UNEXPECTED => 1) ;
} qr/Invalid Option 'SOMETHING_UNEXPECTED'/, 'invalid parameter' ;
}
{
local $Plan = {'new sub subroutines' => 11} ;
# check the subroutines and get the needed code coverage
my $object = {NAME => 'test', INTERACTION => {}} ;
Eval::Context::SetInteractionDefault($object) ;
lives_ok
{
Eval::Context::CheckOptionNames($object, {FILE => 1, LINE => 1}) ;
} 'accepts a hash ref as valid options definition' ;
lives_ok
{
Eval::Context::CheckOptionNames($object, [qw(FILE LINE)]) ;
} 'accepts an array ref as valid options definition' ;
throws_ok
{
Eval::Context::CheckOptionNames($object, '') ; #doesn't matter what is passed as argument
} qr/Invalid 'valid_options' definition/, 'invalid option definition' ;
throws_ok
{
Eval::Context::CheckOptionNames($object, [qw(FILE LINE)], FILE => 1) ;
}qr/Incomplete option FILE::LINE/, 'missing LINE' ;
throws_ok
{
Eval::Context::CheckOptionNames($object, [qw(FILE LINE)], LINE => 1) ;
} qr/Incomplete option FILE::LINE/, 'missing FILE' ;
#-------------------------------------------------------------------
my $interaction = {INTERACTION => {}} ;
Eval::Context::SetInteractionDefault($interaction) ;
is(defined $interaction->{INTERACTION}{INFO}, 1, 'interaction INFO defined') ;
is(defined $interaction->{INTERACTION}{WARN}, 1, 'interaction WARN defined') ;
is(defined $interaction->{INTERACTION}{DIE}, 1, 'interaction DIE defined') ;
#-------------------------------------------------------------------
my $the_sub = sub{} ;
$interaction =
{
INTERACTION =>
{
INFO => $the_sub,
WARN => $the_sub,
DIE => $the_sub,
}
} ;
Eval::Context::SetInteractionDefault($interaction) ;
is($interaction->{INTERACTION}{INFO}, $the_sub, 'interaction INFO unchanged') ;
is($interaction->{INTERACTION}{WARN}, $the_sub, 'interaction WARN unchanged') ;
is($interaction->{INTERACTION}{DIE}, $the_sub, 'interaction DIE unchanged') ;
}
|
