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, @left);
  21  {
  22   local $SIG{__WARN__} = sub {
  23    my $w = join '', 'warn:', @_;
  24    if ($w =~ /"P(\d+)"/ and not exists $res{$1}) {
  25     $res{$1} = $w;
  26    } else {
  27     push @left, $w;
  28    }
  29   };
  30   eval "die qq{ok\\n}; $code";
  31   is($@, "ok\n", 'DATA compiled fine');
  32  }
  33  for (1 .. $tests) {
  34   my $w = $res{$_};
  35   if ($wrong{$_}) {
  36    like($w, expect("P$_"), "$_ should warn");
  37   } else {
  38    is($w, undef, "$_ shouldn't warn");
  39   }
  40  }
  41  is(@left, 0, 'nothing left');
  42  diag "Extraneous warnings:\n", @left if @left;
  43 }
  44
  45 {
  46  my $w = '';
  47  local $SIG{__WARN__} = sub {
  48   $w = 'more than 2 warnings' if $w;
  49   $w = join '', 'warn:', @_
  50  };
  51  {
  52   eval 'no indirect; my $x = new Foo';
  53   like($w, expect('Foo'), "eval 'no indirect; my \$x = new Foo'");
  54  }
  55  $w = '';
  56  {
  57   {
  58    no indirect;
  59    eval 'my $x = new Bar';
  60   }
  61   if ($] < 5.010) {
  62    is($w, '', "eval 'no indirect; my \$x = new Bar'");
  63   } else {
  64    like($w, expect('Bar'), "no indirect; eval 'my \$x = new Bar'");
  65   }
  66  }
  67 }
  68
  69 __DATA__
  70 my $a = new P1;
  71
  72 {
  73  no indirect;
  74  my $b = new P2;
  75  {
  76   my $c = new P3;
  77  }
  78  {
  79   use indirect;
  80   my $d = new P4;
  81  }
  82  my $e = new P5;
  83 }
  84
  85 my $f = new P6;
  86
  87 no indirect;
  88
  89 my $g = new P7;
  90
  91 use indirect;
  92
  93 my $h = new P8;
  94
  95 {
  96  no indirect;
  97  eval { my $i = new P9 };
  98 }
  99
 100 eval { no indirect; my $j = new P10 };