3 my $exp0 = ::expected('block', 0, undef);
8 # We're using Test::Leaner here because Test::More loads overload, which itself
9 # uses warning::register, which may cause the "all warnings on" bitmask to
10 # change ; and that doesn't fit well with how we're testing things.
13 use Test::Leaner tests => 19 + 6;
15 use Scope::Upper qw<context_info UP HERE CALLER>;
18 my ($type, $line, $want) = @_;
22 my @caller = caller 1;
30 my ($file, $eval, $require, $hints, $warnings, $hinthash)
31 = @caller[1, 6, 7, 8, 9, 10];
33 $line = $caller[2] unless defined $line;
36 if ($type eq 'sub' or $type eq 'eval' or $type eq 'format') {
38 $hasargs = $caller[4];
40 $want = '' if defined $want and not $want;
43 $want = "$]" < 5.015_001 ? '' : undef if $top;
57 push @exp, $hinthash if "$]" >= 5.010;
65 for my $sub (qw<context_info UP HERE is_deeply expected>) {
67 *{"${pkg}::$sub"} = \&{"main::$sub"};
71 is_deeply [ context_info ], $exp0, 'main : context_info';
72 is_deeply [ context_info(HERE) ], $exp0, 'main : context_info HERE';
73 is_deeply [ context_info(UP) ], $exp0, 'main : context_info UP';
74 is_deeply [ context_info(-1) ], $exp0, 'main : context_info -1';
76 package Scope::Upper::TestPkg::A; BEGIN { ::setup }
78 my $exp1 = expected('sub', undef);
79 is_deeply [ context_info ], $exp1, 'sub0 : context_info';
80 package Scope::Upper::TestPkg::B; BEGIN { ::setup }
82 my $exp2 = expected('block', __LINE__, 1);
83 is_deeply [ context_info ], $exp2, 'sub : context_info';
84 is_deeply [ context_info(UP) ], $exp1, 'sub : context_info UP';
85 package Scope::Upper::TestPkg::C; BEGIN { ::setup }
87 my $exp3 = expected('loop', __LINE__ - 1, undef);
88 is_deeply [ context_info ], $exp3, 'for : context_info';
89 is_deeply [ context_info(UP) ], $exp2, 'for : context_info UP';
90 is_deeply [ context_info(UP UP) ], $exp1, 'for : context_info UP UP';
92 package Scope::Upper::TestPkg::D; BEGIN { ::setup }
93 my $eval_line = __LINE__+1;
95 my $exp4 = expected('eval', $eval_line);
96 is_deeply [ context_info ], $exp4, 'eval string : context_info';
97 is_deeply [ context_info(UP) ], $exp2, 'eval string : context_info UP';
98 is_deeply [ context_info(UP UP) ], $exp1, 'eval string : context_info UP UP';
101 package Scope::Upper::TestPkg::E; BEGIN { ::setup }
103 my $exp5 = expected('eval', __LINE__ - 1);
104 package Scope::Upper::TestPkg::F; BEGIN { ::setup }
106 my $exp6 = expected('block', __LINE__ - 1, undef);
107 is_deeply [ context_info ], $exp6, 'do : context_info';
108 is_deeply [ context_info(UP) ], $exp5, 'do : context_info UP';
109 is_deeply [ context_info(UP UP) ], $exp2, 'do : context_info UP UP';
111 is_deeply [ context_info ], $exp5, 'eval : context_info';
112 is_deeply [ context_info(UP) ], $exp2, 'eval : context_info UP';
113 is_deeply [ context_info(UP UP) ], $exp1, 'eval : context_info UP UP';
146 for my $depth (0 .. 5) {
147 my @got = context_info(CALLER $depth);
148 my @exp = caller $depth;
149 defined and not $_ and $_ = '' for $exp[5];
150 is_deeply \@got, \@exp, "context_info vs caller $depth";