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 => 18 + 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
54 if (defined $warnings and $warnings =~ m/^\x55*$/) {
55 $warnings = $warnings::Bits{all};
70 push @exp, $hinthash if "$]" >= 5.010;
78 for my $sub (qw<context_info UP HERE is_deeply expected>) {
80 *{"${pkg}::$sub"} = \&{"main::$sub"};
84 is_deeply [ context_info ], $exp0, 'main : context_info';
85 is_deeply [ context_info(HERE) ], $exp0, 'main : context_info HERE';
86 is_deeply [ context_info(-1) ], $exp0, 'main : context_info -1';
88 package Scope::Upper::TestPkg::A; BEGIN { ::setup }
90 my $exp1 = expected('sub', undef);
91 is_deeply [ context_info ], $exp1, 'sub0 : context_info';
92 package Scope::Upper::TestPkg::B; BEGIN { ::setup }
94 my $exp2 = expected('block', __LINE__, 1);
95 is_deeply [ context_info ], $exp2, 'sub : context_info';
96 is_deeply [ context_info(UP) ], $exp1, 'sub : context_info UP';
97 package Scope::Upper::TestPkg::C; BEGIN { ::setup }
99 my $exp3 = expected('loop', __LINE__ - 1, undef);
100 is_deeply [ context_info ], $exp3, 'for : context_info';
101 is_deeply [ context_info(UP) ], $exp2, 'for : context_info UP';
102 is_deeply [ context_info(UP UP) ], $exp1, 'for : context_info UP UP';
104 package Scope::Upper::TestPkg::D; BEGIN { ::setup }
105 my $eval_line = __LINE__+1;
107 my $exp4 = expected('eval', $eval_line);
108 is_deeply [ context_info ], $exp4, 'eval string : context_info';
109 is_deeply [ context_info(UP) ], $exp2, 'eval string : context_info UP';
110 is_deeply [ context_info(UP UP) ], $exp1, 'eval string : context_info UP UP';
113 package Scope::Upper::TestPkg::E; BEGIN { ::setup }
115 my $exp5 = expected('eval', __LINE__ - 1);
116 package Scope::Upper::TestPkg::F; BEGIN { ::setup }
118 my $exp6 = expected('block', __LINE__ - 1, undef);
119 is_deeply [ context_info ], $exp6, 'do : context_info';
120 is_deeply [ context_info(UP) ], $exp5, 'do : context_info UP';
121 is_deeply [ context_info(UP UP) ], $exp2, 'do : context_info UP UP';
123 is_deeply [ context_info ], $exp5, 'eval : context_info';
124 is_deeply [ context_info(UP) ], $exp2, 'eval : context_info UP';
125 is_deeply [ context_info(UP UP) ], $exp1, 'eval : context_info UP UP';
158 for my $depth (0 .. 5) {
159 my @got = context_info(CALLER $depth);
160 my @exp = caller $depth;
161 defined and not $_ and $_ = '' for $exp[5];
162 if (defined $exp[9] and $exp[9] =~ m/^\x55*$/) {
163 $exp[9] = $warnings::Bits{all};
165 is_deeply \@got, \@exp, "context_info vs caller $depth";