The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More tests => 20;
use t::lib::capture;

@CAPTURE_OPTS = ('-MDevel::Confess');

is capture <<'END_CODE', <<'END_OUTPUT', 'basic test';
package A;

sub f {
#line 1 test-block.pl
    warn  "Beware!";
}

sub g {
#line 2 test-block.pl
    f();
}

package main;

#line 3 test-block.pl
A::g();
END_CODE
Beware! at test-block.pl line 1.
	A::f() called at test-block.pl line 2
	A::g() called at test-block.pl line 3
END_OUTPUT

is capture <<'END_CODE', <<'END_OUTPUT', 'interpreter-thrown warnings';
package A;

sub f {
	use strict;
	my $a;
#line 1 test-block.pl
	my @a = @$a;
}

sub g {
#line 2 test-block.pl
	f();
}

package main;

#line 3 test-block.pl
A::g();

END_CODE
Can't use an undefined value as an ARRAY reference at test-block.pl line 1.
	A::f() called at test-block.pl line 2
	A::g() called at test-block.pl line 3
END_OUTPUT

for my $type (qw(die croak confess)) {

  is capture <<"END_CODE" , <<'END_OUTPUT', "$type at root";
use Carp;
#line 1 test-block.pl
$type "foo at bar";
END_CODE
foo at bar at test-block.pl line 1.
END_OUTPUT

  is capture <<"END_CODE" , <<'END_OUTPUT', "$type in sub";
use Carp;
sub foo {
#line 1 test-block.pl
  $type "foo at bar";
}
#line 2 test-block.pl
foo();
END_CODE
foo at bar at test-block.pl line 1.
	main::foo() called at test-block.pl line 2
END_OUTPUT

  is capture <<"END_CODE" , <<'END_OUTPUT', "$type with newline";
use Carp;
sub foo {
#line 1 test-block.pl
  $type "foo at bar\n";
}
sub bar {
#line 2 test-block.pl
  foo();
}
#line 3 test-block.pl
bar();
END_CODE
foo at bar
 at test-block.pl line 1.
	main::foo() called at test-block.pl line 2
	main::bar() called at test-block.pl line 3
END_OUTPUT

  like capture <<"END_CODE", qr/${\<<'END_OUTPUT'}/, "$type with object";
use Carp;
sub foo {
#line 1 test-block.pl
  $type bless {}, 'NoOverload';
}
#line 2 test-block.pl
foo();
END_CODE
NoOverload=HASH\(0x\w+\) at test-block\.pl line 1\.
	main::foo\(\) called at test-block\.pl line 2
END_OUTPUT

  is capture <<"END_CODE", <<'END_OUTPUT', "$type with object with overload";
use Carp;
{
  package HasOverload;
  use overload '""' => sub { "message" };
}
sub foo {
#line 1 test-block.pl
  $type bless {}, 'HasOverload';
}
#line 2 test-block.pl
foo();
END_CODE
message at test-block.pl line 1.
	main::foo() called at test-block.pl line 2
END_OUTPUT

  like capture <<"END_CODE", qr/${\<<'END_OUTPUT'}/, "$type with non-object ref";
use Carp;
sub foo {
#line 1 test-block.pl
  $type [1];
}
#line 2 test-block.pl
foo();
END_CODE
^ARRAY\(0x\w+\) at test-block\.pl line 1\.
	main::foo\(\) called at test-block\.pl line 2
END_OUTPUT

}