t/attributes/accessor_override_method.t

   1 #!/usr/bin/env perl
   2 use strict;
   3 use warnings;
   4 use Test::More;
   5
   6 use Test::Requires {
   7     'Test::Output' => '0.01',    # skip all if not installed
   8 };
   9
  10 {
  11
  12     package Foo;
  13     use Moose;
  14
  15     sub get_a   { }
  16     sub set_b   { }
  17     sub has_c   { }
  18     sub clear_d { }
  19     sub e       { }
  20 }
  21
  22 my $foo_meta = Foo->meta;
  23 stderr_like(
  24     sub { $foo_meta->add_attribute( a => ( reader => 'get_a' ) ) },
  25     qr/^You are overwriting a locally defined method \(get_a\) with an accessor/,
  26     'reader overriding gives proper warning'
  27 );
  28 stderr_like(
  29     sub { $foo_meta->add_attribute( b => ( writer => 'set_b' ) ) },
  30     qr/^You are overwriting a locally defined method \(set_b\) with an accessor/,
  31     'writer overriding gives proper warning'
  32 );
  33 stderr_like(
  34     sub { $foo_meta->add_attribute( c => ( predicate => 'has_c' ) ) },
  35     qr/^You are overwriting a locally defined method \(has_c\) with an accessor/,
  36     'predicate overriding gives proper warning'
  37 );
  38 stderr_like(
  39     sub { $foo_meta->add_attribute( d => ( clearer => 'clear_d' ) ) },
  40     qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/,
  41     'clearer overriding gives proper warning'
  42 );
  43 stderr_like(
  44     sub { $foo_meta->add_attribute( e => ( is => 'rw' ) ) },
  45     qr/^You are overwriting a locally defined method \(e\) with an accessor/,
  46     'accessor overriding gives proper warning'
  47 );
  48 stderr_like(
  49     sub { $foo_meta->add_attribute( has => ( is => 'rw' ) ) },
  50     qr/^You are overwriting a locally defined function \(has\) with an accessor/,
  51     'function overriding gives proper warning'
  52 );
  53
  54 done_testing;