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
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(-1) ], $exp0, 'main : context_info -1';
85 package Scope::Upper::TestPkg::A; BEGIN { ::setup }
87 my $exp1 = expected('sub', undef);
88 is_deeply [ context_info ], $exp1, 'sub0 : context_info';
89 package Scope::Upper::TestPkg::B; BEGIN { ::setup }
91 my $exp2 = expected('block', __LINE__, 1);
92 is_deeply [ context_info ], $exp2, 'sub : context_info';
93 is_deeply [ context_info(UP) ], $exp1, 'sub : context_info UP';
94 package Scope::Upper::TestPkg::C; BEGIN { ::setup }
96 my $exp3 = expected('loop', __LINE__ - 1, undef);
97 is_deeply [ context_info ], $exp3, 'for : context_info';
98 is_deeply [ context_info(UP) ], $exp2, 'for : context_info UP';
99 is_deeply [ context_info(UP UP) ], $exp1, 'for : context_info UP UP';
101 package Scope::Upper::TestPkg::D; BEGIN { ::setup }
102 my $eval_line = __LINE__+1;
104 my $exp4 = expected('eval', $eval_line);
105 is_deeply [ context_info ], $exp4, 'eval string : context_info';
106 is_deeply [ context_info(UP) ], $exp2, 'eval string : context_info UP';
107 is_deeply [ context_info(UP UP) ], $exp1, 'eval string : context_info UP UP';
110 package Scope::Upper::TestPkg::E; BEGIN { ::setup }
112 my $exp5 = expected('eval', __LINE__ - 1);
113 package Scope::Upper::TestPkg::F; BEGIN { ::setup }
115 my $exp6 = expected('block', __LINE__ - 1, undef);
116 is_deeply [ context_info ], $exp6, 'do : context_info';
117 is_deeply [ context_info(UP) ], $exp5, 'do : context_info UP';
118 is_deeply [ context_info(UP UP) ], $exp2, 'do : context_info UP UP';
120 is_deeply [ context_info ], $exp5, 'eval : context_info';
121 is_deeply [ context_info(UP) ], $exp2, 'eval : context_info UP';
122 is_deeply [ context_info(UP UP) ], $exp1, 'eval : context_info UP UP';
155 for my $depth (0 .. 5) {
156 my @got = context_info(CALLER $depth);
157 my @exp = caller $depth;
158 defined and not $_ and $_ = '' for $exp[5];
159 is_deeply \@got, \@exp, "context_info vs caller $depth";