view release on metacpan or  search on metacpan

t/04-warns.t  view on Meta::CPAN

                    reserved parenthesis taint closure semicolon);
    no warnings qw(exec newline);
=cut

sub DIAG () { 0 }

my $unopened = 10;
open my $closed, '>', \(my $o = "");close $closed;
open my $raw, '>:raw', \(my $x = "");

sub test_warn_die(&;@) {
	my $code = shift;
	my $name = shift;
	my $warn = 0;
	my $die = 0;
	local $SIG{__WARN__} = sub {
		$warn = 1;
		DIAG and diag "$name should not: @_"
	};
	local $SIG{__DIE__}  = sub { $die = 1; };
	my $rc = eval {
		$code->();
	1};
	my $e = $@;
	ok !$warn, "$name - no warn";
	ok $die,   "$name - died";
	ok !$rc,   "$name - eval failed";
	ok $e,     "$name - have error" and DIAG and diag $e;
	
}

sub test_no_warn(&;@) {
	my $code = shift;
	my $name = shift;
	my $warn = 0;
	local $SIG{__WARN__} = sub {
		$warn = 1;
		diag "$name: @_";
	};
	$code->();
	ok !$warn, "$name - no warn";
}