File Coverage

lib/Marpa/HTML/Test/Util.pm

Criterion	Covered	Total	%
statement	39	43	90.7
branch	2	4	50.0
condition			n/a
subroutine	12	12	100.0
pod	0	4	0.0
total	53	63	84.1

# This software is copyright (c) 2011 by Jeffrey Kegler
# This is free software; you can redistribute it and/or modify it
# under the same terms as the Perl 5 programming language system
# itself.

package Marpa::HTML::Test::Util;

# The original of this code was copied from Andy Lester's Ack
# package

use 5.010;
use strict;
use warnings;

use Test::More;
use English qw( -no_match_vars );
use File::Spec;
use Fatal qw(unlink open close);
use Carp;

# capture stderr output into this file
my $catcherr_file = 'stderr.log';

sub is_win32 {
    return $OSNAME =~ /Win32/xms;
}

# capture-stderr is executing ack and storing the stderr output in
# $catcherr_file in a portable way.
#
# The quoting of command line arguments depends on the OS
sub build_command_line {
    my (@args) = @_;

    if ( is_win32() ) {
        for (@args) {
            s/(\\+)$/$1$1/xms;    # Double all trailing backslashes
            s/"/\\"/gxms;         # Backslash all quotes
            $_ = qq{"$_"};
        }
    } ## end if ( is_win32() )
    else {
        @args = map { quotemeta $_ } @args;
    }

    return "$EXECUTABLE_NAME -Ilib @args";
    # capture-stderr drops core on my Mac OS Tiger laptop
    # return
        # "$EXECUTABLE_NAME -Ilib ./lib/Marpa/HTML/Test/capture-stderr $catcherr_file @args";
} ## end sub build_command_line

sub run_command {
    my ( $command, @args ) = @_;

    my ( $stdout, $stderr ) = run_with_stderr( $command, @args );

    Test::More::is( $stderr, q{},
        "Should have no output to stderr: $command @args" )
        or Test::More::diag("STDERR:\n$stderr");

    return $stdout;
} ## end sub run_command

sub run_with_stderr {
    my @args = @_;

    my $cmd = build_command_line(@args);

    ## no critic (InputOutput::ProhibitBacktickOperators)
    my $stdout = `$cmd`;
    ## use critic

    my ( $sig, $core, $rc ) = (
        ( $CHILD_ERROR & 127 ),
        ( $CHILD_ERROR & 128 ),
        ( $CHILD_ERROR >> 8 ),
    );

    # Previous logic drops core on Darwin
    # open my $fh, '<', $catcherr_file;
    # my $stderr = do { local $RS = undef; <$fh> };
    # close $fh;
    # unlink $catcherr_file;

    return ( $stdout, q{}, $rc );
    # return ( $stdout, $stderr, $rc );
} ## end sub run_with_stderr

1;