File Coverage

blib/lib/Test/CChecker.pm

Criterion	Covered	Total	%
statement	67	91	73.6
branch	13	32	40.6
condition	7	19	36.8
subroutine	16	20	80.0
pod	7	7	100.0
total	110	169	65.0

package Test::CChecker;

use strict;
use warnings;
use base qw( Test::Builder::Module );
use ExtUtils::CChecker;
use Capture::Tiny qw( capture_merged );
use Text::ParseWords qw( shellwords );
use Env qw( @LD_LIBRARY_PATH );
use File::Spec;
use FindBin ();
use File::Temp ();
use Scalar::Util qw( blessed );

our @EXPORT = qw(
  cc
  compile_ok
  compile_run_ok
  compile_with_alien
  compile_output_to_nowhere
  compile_output_to_diag
  compile_output_to_note
);

# ABSTRACT: Test-time utilities for checking C headers, libraries, or OS features (DEPRECATED)
our $VERSION = '0.08'; # VERSION


do {
  my $cc;
  sub cc ()
  {
    $cc ||= ExtUtils::CChecker->new( quiet => 0 );
  }
};


my $output = '';

sub compile_run_ok ($;$)
{
  my($args, $message) = @_;
  $message ||= "compile ok";
  my $cc = cc();
  my $tb = __PACKAGE__->builder;

  my $ok;
  my $out = capture_merged { $ok = $cc->try_compile_run(ref($args) eq 'HASH' ? %$args : $args) };

  $tb->ok($ok, $message);
  if(!$ok || $output eq 'diag')
  {
    $tb->diag($out);
  }
  elsif($output eq 'note')
  {
    $tb->note($out);
  }

  $ok;
}


sub compile_ok ($;$)
{
  my($args, $message) = @_;
  $message ||= "compile ok";
  $args = ref $args ? $args : { source => $args };
  my $cc = cc();
  my $tb = __PACKAGE__->builder;

  my($fh, $filename) = File::Temp::tempfile("ccheckerXXXXX", SUFFIX => '.c');
  print $fh $args->{source};
  close $fh;
  my $obj;
  my %compile = ( source => $filename );
  $compile{extra_compiler_flags} = $args->{extra_compiler_flags} if defined $args->{extra_compiler_flags};
  my $err;
  my $out = capture_merged { $obj = eval { $cc->compile(%compile) }; $err = $@ };

  my $ok = !!$obj;
  unlink $filename if $ok;
  unlink $obj if defined $obj && -f $obj;
  $tb->ok($ok, $message);
  if(!$ok || $output eq 'diag')
  {
    $tb->diag($out);
  }
  elsif($output eq 'note')
  {
    $tb->note($out);
  }

  $tb->diag($err) if $err;

  $ok;
}


sub compile_with_alien ($)
{
  my $alien = shift;
  $alien = $alien->new unless ref $alien;

  if($alien->can('dist_dir'))
  {
    my $dir = eval { File::Spec->catdir($alien->dist_dir, 'lib') };
    unshift @LD_LIBRARY_PATH, $dir if defined $dir && -d $dir;
  }

  my $tdir = File::Spec->catdir($FindBin::Bin, File::Spec->updir, '_test');
  if(-d $tdir)
  {
    cc->push_extra_compiler_flags(map {
      /^-I(.*)$/ ? ("-I".File::Spec->catdir($tdir, $1), $_) : ($_)
    } shellwords $alien->cflags);
    cc->push_extra_linker_flags(map {
      /^-L(.*)$/ ? ( map { push @LD_LIBRARY_PATH, $_; "-L$_" } File::Spec->catdir($tdir, $1), $_) : ($_)
    } shellwords $alien->libs);
  }
  else
  {
    cc->push_extra_compiler_flags(shellwords $alien->cflags);
    cc->push_extra_linker_flags(shellwords $alien->libs);
  }

  return;
}


sub compile_output_to_nowhere ()
{
  $output = '';
}


sub compile_output_to_diag ()
{
  $output = 'diag';
}


sub compile_output_to_note ()
{
  $output = 'note';
}

1;

__END__