3 my $exp0 = ::expected('block', 0, undef);
8 use Config qw<%Config>;
10 # We're using Test::Leaner here because Test::More loads overload, which itself
11 # uses warning::register, which may cause the "all warnings on" bitmask to
12 # change ; and that doesn't fit well with how we're testing things.
15 use Test::Leaner tests => 19 + 6;
17 use Scope::Upper qw<context_info UP HERE CALLER>;
19 sub HINT_BLOCK_SCOPE () { 0x100 }
22 my ($type, $line, $want) = @_;
26 my @caller = caller 1;
34 my ($file, $eval, $require, $hints, $warnings, $hinthash)
35 = @caller[1, 6, 7, 8, 9, 10];
37 $line = $caller[2] unless defined $line;
40 if ($type eq 'sub' or $type eq 'eval' or $type eq 'format') {
42 $hasargs = $caller[4];
44 $want = '' if defined $want and not $want;
48 $want = "$]" < 5.015_001 ? '' : undef;
49 $hints &= ~HINT_BLOCK_SCOPE if $Config{usesitecustomize};
50 $hints |= HINT_BLOCK_SCOPE if "$]" >= 5.019003;
51 $warnings = sub { use warnings; (caller 0)[9] }->() if "$]" < 5.007
67 push @exp, $hinthash if "$]" >= 5.010;
75 for my $sub (qw<context_info UP HERE is_deeply expected>) {
77 *{"${pkg}::$sub"} = \&{"main::$sub"};
81 is_deeply [ context_info ], $exp0, 'main : context_info';
82 is_deeply [ context_info(HERE) ], $exp0, 'main : context_info HERE';
83 is_deeply [ context_info(UP) ], $exp0, 'main : context_info UP';
84 is_deeply [ context_info(-1) ], $exp0, 'main : context_info -1';
86 package Scope::Upper::TestPkg::A; BEGIN { ::setup }
88 my $exp1 = expected('sub', undef);
89 is_deeply [ context_info ], $exp1, 'sub0 : context_info';
90 package Scope::Upper::TestPkg::B; BEGIN { ::setup }
92 my $exp2 = expected('block', __LINE__, 1);
93 is_deeply [ context_info ], $exp2, 'sub : context_info';
94 is_deeply [ context_info(UP) ], $exp1, 'sub : context_info UP';
95 package Scope::Upper::TestPkg::C; BEGIN { ::setup }
97 my $exp3 = expected('loop', __LINE__ - 1, undef);
98 is_deeply [ context_info ], $exp3, 'for : context_info';
99 is_deeply [ context_info(UP) ], $exp2, 'for : context_info UP';
100 is_deeply [ context_info(UP UP) ], $exp1, 'for : context_info UP UP';
102 package Scope::Upper::TestPkg::D; BEGIN { ::setup }
103 my $eval_line = __LINE__+1;
105 my $exp4 = expected('eval', $eval_line);
106 is_deeply [ context_info ], $exp4, 'eval string : context_info';
107 is_deeply [ context_info(UP) ], $exp2, 'eval string : context_info UP';
108 is_deeply [ context_info(UP UP) ], $exp1, 'eval string : context_info UP UP';
111 package Scope::Upper::TestPkg::E; BEGIN { ::setup }
113 my $exp5 = expected('eval', __LINE__ - 1);
114 package Scope::Upper::TestPkg::F; BEGIN { ::setup }
116 my $exp6 = expected('block', __LINE__ - 1, undef);
117 is_deeply [ context_info ], $exp6, 'do : context_info';
118 is_deeply [ context_info(UP) ], $exp5, 'do : context_info UP';
119 is_deeply [ context_info(UP UP) ], $exp2, 'do : context_info UP UP';
121 is_deeply [ context_info ], $exp5, 'eval : context_info';
122 is_deeply [ context_info(UP) ], $exp2, 'eval : context_info UP';
123 is_deeply [ context_info(UP UP) ], $exp1, 'eval : context_info UP UP';
156 for my $depth (0 .. 5) {
157 my @got = context_info(CALLER $depth);
158 my @exp = caller $depth;
159 defined and not $_ and $_ = '' for $exp[5];
160 is_deeply \@got, \@exp, "context_info vs caller $depth";