dist/base/t/warnings.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use Test::More tests => 1;
   6
   7 my $warnings;
   8 BEGIN {
   9     $SIG{__WARN__} = sub { $warnings = join '', @_ };
  10 }
  11
  12 {
  13     package Foo;
  14     use fields qw(thing);
  15 }
  16
  17 {
  18     package Bar;
  19     use fields qw(stuff);
  20     use base qw(Foo);
  21 }
  22
  23 ::like $warnings,
  24        '/^Bar is inheriting from Foo but already has its own fields!/',
  25        'Inheriting from a base with protected fields warns';