view release on metacpan or  search on metacpan

t/app/prove/plugin/metrics.t  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use App::Prove;
use Test::More tests=>6;

my $sbackup = {};
sub steal_stderr {
    my ($sref) = @_;
    if (!defined($$sbackup{stderr})) {
        open($$sbackup{stderr}, '>&STDERR');
        close(STDERR);
    }
    $$sref = undef;
    open(STDERR, '>', $sref);
}
sub return_stderr {
    if (defined($$sbackup{stderr})) {
        close(STDERR);
        open(STDERR, '>&', $$sbackup{stderr});
        delete($$sbackup{stderr});
    }
}

subtest 'stderr, all data'=>sub {
	plan tests=>16;
	my $prove=App::Prove->new();
	$prove->process_args('-PMetrics=stderr,prefix,PRE,sep, SEP ,subdepth,-1,label,1,rollup,0',glob('t/tests/simple-*.tt'));
	my $serr; steal_stderr(\$serr);
	$prove->run();
	return_stderr();
	my %seen=map {$_=>1} map {s/\s+/ /gr} grep {/^METRIC:/} split(/\n/,$serr);
	foreach my $expect (
		['simple-0-1',     1,'PRE SEP t/tests/simple-0-1.tt SEP okA'],
		['simple-1-1-1',   1,'PRE SEP t/tests/simple-1-1.tt SEP Level1 SEP okA'],
		['simple-1-1-0',   1,'PRE SEP t/tests/simple-1-1.tt SEP Level1'],
		['simple-2-1-2',   1,'PRE SEP t/tests/simple-2-1.tt SEP Level1 SEP Level2 SEP okA'],
		['simple-2-1-1',   1,'PRE SEP t/tests/simple-2-1.tt SEP Level1 SEP Level2'],
		['simple-2-1-0',   1,'PRE SEP t/tests/simple-2-1.tt SEP Level1'],
		['simple-0-0',     0,'PRE SEP t/tests/simple-0-0.tt SEP failA'],
		['simple-1-0-1',   0,'PRE SEP t/tests/simple-1-0.tt SEP Level1 SEP failA'],
		['simple-1-0-0',   0,'PRE SEP t/tests/simple-1-0.tt SEP Level1'],
		['simple-2-0-2',   0,'PRE SEP t/tests/simple-2-0.tt SEP Level1 SEP Level2 SEP failA'],
		['simple-2-0-1',   0,'PRE SEP t/tests/simple-2-0.tt SEP Level1 SEP Level2'],
		['simple-2-0-0',   0,'PRE SEP t/tests/simple-2-0.tt SEP Level1'],
		['simple-1-0-n-0', 0,'PRE SEP t/tests/simple-1-0-n.tt SEP Level1'],
		['simple-1-0-ul-1',0,'PRE SEP t/tests/simple-1-0-ul.tt SEP Level1 SEP '],
		['simple-1-0-ul-0',0,'PRE SEP t/tests/simple-1-0-ul.tt SEP Level1'],
	) {
		ok($seen{"METRIC: $$expect[1] $$expect[2]"},$$expect[0]);
	}
	#
	is(scalar(keys %seen),15,'Pigeonhole');
};

subtest 'stderr, all data, no label'=>sub {
	plan tests=>17;
	my $prove=App::Prove->new();
	$prove->process_args('-PMetrics=stderr,prefix,PRE,sep, SEP ,subdepth,-1,label,0,rollup,0',glob('t/tests/simple-*.tt'));
	my $serr; steal_stderr(\$serr);
	$prove->run();
	return_stderr();
	my %seen=map {$_=>1} map {s/\s+/ /gr} grep {/^METRIC:/} split(/\n/,$serr);
	foreach my $expect (
		['simple-0-1',     1,'PRE SEP t/tests/simple-0-1.tt'],
		['simple-1-1-1',   1,'PRE SEP t/tests/simple-1-1.tt SEP Level1'],
		['simple-1-1-0',   1,'PRE SEP t/tests/simple-1-1.tt'],
		['simple-2-1-2',   1,'PRE SEP t/tests/simple-2-1.tt SEP Level1 SEP Level2'],
		['simple-2-1-1',   1,'PRE SEP t/tests/simple-2-1.tt SEP Level1'],
		['simple-2-1-0',   1,'PRE SEP t/tests/simple-2-1.tt'],
		['simple-0-0',     0,'PRE SEP t/tests/simple-0-0.tt'],
		['simple-1-0-1',   0,'PRE SEP t/tests/simple-1-0.tt SEP Level1'],
		['simple-1-0-0',   0,'PRE SEP t/tests/simple-1-0.tt'],
		['simple-2-0-2',   0,'PRE SEP t/tests/simple-2-0.tt SEP Level1 SEP Level2'],
		['simple-2-0-1',   0,'PRE SEP t/tests/simple-2-0.tt SEP Level1'],
		['simple-2-0-0',   0,'PRE SEP t/tests/simple-2-0.tt'],
		['simple-1-0-n-1', 0,'PRE SEP t/tests/simple-1-0-n.tt SEP Level1'],
		['simple-1-0-n-0', 0,'PRE SEP t/tests/simple-1-0-n.tt'],
		['simple-1-0-ul-1',0,'PRE SEP t/tests/simple-1-0-ul.tt SEP Level1'],
		['simple-1-0-ul-0',0,'PRE SEP t/tests/simple-1-0-ul.tt'],
	) {