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     sub stub;
  21 }
  22
  23 my $foo_meta = Foo->meta;
  24 stderr_like(
  25     sub { $foo_meta->add_attribute( a => ( reader => 'get_a' ) ) },
  26     qr/^You are overwriting a locally defined method \(get_a\) with an accessor/,
  27     'reader overriding gives proper warning'
  28 );
  29 stderr_like(
  30     sub { $foo_meta->add_attribute( b => ( writer => 'set_b' ) ) },
  31     qr/^You are overwriting a locally defined method \(set_b\) with an accessor/,
  32     'writer overriding gives proper warning'
  33 );
  34 stderr_like(
  35     sub { $foo_meta->add_attribute( c => ( predicate => 'has_c' ) ) },
  36     qr/^You are overwriting a locally defined method \(has_c\) with an accessor/,
  37     'predicate overriding gives proper warning'
  38 );
  39 stderr_like(
  40     sub { $foo_meta->add_attribute( d => ( clearer => 'clear_d' ) ) },
  41     qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/,
  42     'clearer overriding gives proper warning'
  43 );
  44 stderr_like(
  45     sub { $foo_meta->add_attribute( e => ( is => 'rw' ) ) },
  46     qr/^You are overwriting a locally defined method \(e\) with an accessor/,
  47     'accessor overriding gives proper warning'
  48 );
  49 stderr_is(
  50     sub { $foo_meta->add_attribute( stub => ( is => 'rw' ) ) },
  51     q{},
  52     'overriding a stub with an accessor does not warn'
  53 );
  54 stderr_like(
  55     sub { $foo_meta->add_attribute( has => ( is => 'rw' ) ) },
  56     qr/^You are overwriting a locally defined function \(has\) with an accessor/,
  57     'function overriding gives proper warning'
  58 );
  59
  60 done_testing;