]> git.vpit.fr Git - perl/modules/indirect.git/blob - t/30-scope.t
Fix a possible collisions by hashing pointers with the format %u
[perl/modules/indirect.git] / t / 30-scope.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 my $tests;
7 BEGIN { $tests = 10 }
8
9 use Test::More tests => 1 + $tests + 1 + 2;
10
11 my %wrong = map { $_ => 1 } 2, 3, 5, 7, 9, 10;
12
13 sub expect {
14  my ($pkg) = @_;
15  return qr/^warn:Indirect\s+call\s+of\s+method\s+"new"\s+on\s+object\s+"$pkg"/;
16 }
17
18 {
19  my $code = do { local $/; <DATA> };
20  my (%res, $num, @left);
21  {
22   local $SIG{__WARN__} = sub {
23    ++$num;
24    my $w = join '', 'warn:', @_;
25    if ($w =~ /"P(\d+)"/ and not exists $res{$1}) {
26     $res{$1} = $w;
27    } else {
28     push @left, "[$num] $w";
29    }
30   };
31   eval "die qq{ok\\n}; $code";
32   is($@, "ok\n", 'DATA compiled fine');
33  }
34  for (1 .. $tests) {
35   my $w = $res{$_};
36   if ($wrong{$_}) {
37    like($w, expect("P$_"), "$_ should warn");
38   } else {
39    is($w, undef, "$_ shouldn't warn");
40   }
41  }
42  is(@left, 0, 'nothing left');
43  diag "Extraneous warnings:\n", @left if @left;
44 }
45
46 {
47  my $w = '';
48  local $SIG{__WARN__} = sub {
49   $w = 'more than 2 warnings' if $w;
50   $w = join '', 'warn:', @_
51  };
52  {
53   eval 'no indirect; my $x = new Foo';
54   like($w, expect('Foo'), "eval 'no indirect; my \$x = new Foo'");
55  }
56  $w = '';
57  {
58   {
59    no indirect;
60    eval 'my $x = new Bar';
61   }
62   if ($] < 5.010) {
63    is($w, '', "eval 'no indirect; my \$x = new Bar'");
64   } else {
65    like($w, expect('Bar'), "no indirect; eval 'my \$x = new Bar'");
66   }
67  }
68 }
69
70 __DATA__
71 my $a = new P1;
72
73 {
74  no indirect;
75  my $b = new P2;
76  {
77   my $c = new P3;
78  }
79  {
80   use indirect;
81   my $d = new P4;
82  }
83  my $e = new P5;
84 }
85
86 my $f = new P6;
87
88 no indirect;
89
90 my $g = new P7;
91
92 use indirect;
93
94 my $h = new P8;
95
96 {
97  no indirect;
98  eval { my $i = new P9 };
99 }
100
101 eval { no indirect; my $j = new P10 };