t/010_basics/007_always_strict_warnings.t

   1 #!/usr/bin/perl
   2
   3 use Test::More tests => 10;
   4
   5 # for classes ...
   6 {
   7     package Foo;
   8     use Mouse;
   9
  10     eval '$foo = 5;';
  11     ::ok($@, '... got an error because strict is on');
  12     ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
  13
  14     {
  15         my $warn;
  16         local $SIG{__WARN__} = sub { $warn = $_[0] };
  17
  18         ::ok(!$warn, '... no warning yet');
  19
  20         eval 'my $bar = 1 + "hello"';
  21
  22         ::ok($warn, '... got a warning');
  23         ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
  24     }
  25 }
  26
  27 # and for roles ...
  28 {
  29     package Bar;
  30     use Mouse::Role;
  31
  32     eval '$foo = 5;';
  33     ::ok($@, '... got an error because strict is on');
  34     ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
  35
  36     {
  37         my $warn;
  38         local $SIG{__WARN__} = sub { $warn = $_[0] };
  39
  40         ::ok(!$warn, '... no warning yet');
  41
  42         eval 'my $bar = 1 + "hello"';
  43
  44         ::ok($warn, '... got a warning');
  45         ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
  46     }
  47 }
  48 __END__
  49 # Mouse::Export does not yet exist
  50
  51 # and for exporters
  52 {
  53     package Bar;
  54     use Mouse::Exporter;
  55
  56     eval '$foo = 5;';
  57     ::ok($@, '... got an error because strict is on');
  58     ::like($@, qr/Global symbol \"\$foo\" requires explicit package name at/, '... got the right error');
  59
  60     {
  61         my $warn;
  62         local $SIG{__WARN__} = sub { $warn = $_[0] };
  63
  64         ::ok(!$warn, '... no warning yet');
  65
  66         eval 'my $bar = 1 + "hello"';
  67
  68         ::ok($warn, '... got a warning');
  69         ::like($warn, qr/Argument \"hello\" isn\'t numeric in addition \(\+\)/, '.. and it is the right warning');
  70     }
  71 }