t/30-scope.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 my $tests;
   7 BEGIN { $tests = 8 }
   8
   9 use Test::More tests => 1 + $tests + 1 + 2;
  10
  11 my %wrong = map { $_ => 1 } 2, 3, 5, 7;
  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 @warns;
  21  {
  22   local $SIG{__WARN__} = sub { push @warns, join '', 'warn:', @_ };
  23   eval "die qq{ok\\n}; $code";
  24   is($@, "ok\n", 'DATA compiled fine');
  25  }
  26  my $left = 0;
  27  my %res = map {
  28   if (/"P(\d+)"/) {
  29    $1 => $_
  30   } else {
  31    ++$left; ()
  32   }
  33  } @warns;
  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 }
  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;