t/10-args.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4 + 1 + 1;
   7
   8 sub expect {
   9  my ($pkg) = @_;
  10  qr/^Indirect call of method "new" on object "$pkg" at \(eval \d+\) line \d+/;
  11 }
  12
  13 {
  14  my @warns;
  15  {
  16   local $SIG{__WARN__} = sub { push @warns, "@_" };
  17   eval <<'  HERE';
  18    return;
  19    no indirect;
  20    my $x = new Warn1;
  21    $x = new Warn2;
  22   HERE
  23  }
  24  my $w1 = shift @warns;
  25  my $w2 = shift @warns;
  26  is             $@, '',              'didn\'t croak without arguments';
  27  like          $w1, expect('Warn1'), 'first warning caught without arguments';
  28  like          $w2, expect('Warn2'), 'second warning caught without arguments';
  29  is_deeply \@warns, [ ],             'no more warnings without arguments';
  30 }
  31
  32 {
  33  {
  34   local $SIG{__WARN__} = sub { die "warn:@_" };
  35   eval <<'  HERE';
  36    die qq{shouldn't even compile\n};
  37    no indirect ':fatal', hook => sub { die 'should not be called' };
  38    my $x = new Croaked;
  39    $x = new NotReached;
  40   HERE
  41  }
  42  like $@, expect('Croaked'), 'croaks when :fatal is specified';
  43 }
  44
  45 {
  46  {
  47   local $SIG{__WARN__} = sub { "warn:@_" };
  48   eval <<'  HERE';
  49    die qq{shouldn't even compile\n};
  50    no indirect 'whatever', hook => sub { die 'hook:' . join(':', @_) . "\n" }, ':fatal';
  51    my $x = new Hooked;
  52    $x = new AlsoNotReached;
  53   HERE
  54  }
  55  like $@, qr/^hook:Hooked:new:\(eval\s+\d+\):\d+$/, 'calls the specified hook';
  56 }