t/proto.t

   1 BEGIN { our @warnings; $SIG{__WARN__} = sub { push(@warnings, $_[0]); } }
   2
   3 use strict;
   4 use warnings;
   5
   6 sub foo (&) {
   7   $_[0]->();
   8   ();
   9 }
  10
  11 sub bar {
  12   my ($name, $val) = @_;
  13   no strict 'refs';
  14   *{$name} = sub (&) { $_[0]->($val); };
  15 }
  16
  17 use Devel::BeginLift 'foo';
  18
  19 foo {
  20   bar "boom1" => "BOOM 1";
  21   bar "boom2" => "BOOM 2";
  22 };
  23
  24 boom1 { warn "1: $_[0]\n"; };
  25
  26 boom2 { warn "2: $_[0]\n"; };
  27
  28 END {
  29   use Test::More 'no_plan';
  30   our @warnings;
  31   is(shift(@warnings), "1: BOOM 1\n", 'boom1');
  32   is(shift(@warnings), "2: BOOM 2\n", 'boom2');
  33   ok(!@warnings, 'No more warnings');
  34 }