The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Moo::_strictures;
use Test::More;
use Test::Fatal;


BEGIN {
  package AddOverrides;
  $INC{"AddOverrides.pm"} = __FILE__;
  use Carp ();
  sub import {
    my $package = caller;
    for my $sub (
      'defined',
      'join',
      'ref',
      'die',
      'shift',
      'sort',
      'undef',
    ) {
      my $proto = prototype "CORE::$sub";
      no strict 'refs';
      *{"${package}::$sub"} = \&{"${package}::$sub"};
      eval "sub ${package}::$sub ".($proto ? "($proto)" : '') . ' { Carp::confess("local '.$sub.'") }; 1'
        or die $@;
    }
  }
}

{
  package Foo;
  use Moo;
  sub welp { 1 }
}

{
  package WithOverridden;
  use AddOverrides;
  use Moo;

  sub BUILD { 1 }
  sub DEMOLISH { CORE::die "demolish\n" if $::FATAL_DEMOLISH }
  around BUILDARGS => sub {
    my $orig = CORE::shift();
    my $self = CORE::shift();
    $self->$orig(@_);
  };

  has attr1 => (is => 'ro', required => 1, handles => ['welp']);
  has attr2 => (is => 'ro', default => CORE::undef());
  has attr3 => (is => 'rw', isa => sub { CORE::die "nope" } );
}

unlike exception { WithOverridden->new(1) }, qr/local/,
  'bad constructor arguments error ignores local functions';
unlike exception { WithOverridden->new }, qr/local/,
  'missing attributes error ignores local functions';
unlike exception { WithOverridden->new(attr1 => 1, attr3 => 1) }, qr/local/,
  'constructor isa checks ignores local functions';
my $o;
is exception { $o = WithOverridden->new(attr1 => Foo->new) }, undef,
  'constructor without error ignores local functions';
unlike exception { $o->attr3(1) }, qr/local/,
  'isa checks ignores local functions';
is exception { $o->welp }, undef,
  'delegates ignores local functions';

{
  no warnings FATAL => 'all';
  use warnings 'all';
  my $w = '';
  local $SIG{__WARN__} = sub { $w .= $_[0] };
  local $::FATAL_DEMOLISH = 1;
  undef $o;
  unlike $w, qr/local/,
    'destroy ignores local functions';
}

done_testing;