File Coverage

blib/lib/Test/Alien/CPP.pm
Criterion Covered Total %
statement 39 41 95.1
branch 7 14 50.0
condition 1 3 33.3
subroutine 8 8 100.0
pod 1 1 100.0
total 56 67 83.5


line stmt bran cond sub pod time code
1             package Test::Alien::CPP;
2              
3 3     3   456175 use strict;
  3         16  
  3         89  
4 3     3   18 use warnings;
  3         6  
  3         107  
5 3     3   95 use 5.008001;
  3         11  
6 3     3   1423 use ExtUtils::CppGuess;
  3         91458  
  3         112  
7 3     3   1546 use Test::Alien 1.00 ();
  3         86465  
  3         91  
8 3     3   24 use Text::ParseWords qw( shellwords );
  3         9  
  3         151  
9 3     3   19 use base qw( Exporter );
  3         7  
  3         1355  
10              
11             # ABSTRACT: Testing tools for Alien modules for projects that use C++
12             our $VERSION = '1.01'; # VERSION
13              
14              
15             our @EXPORT = @Test::Alien::EXPORT;
16              
17             Test::Alien->import(grep !/^xs_ok$/, @EXPORT);
18              
19              
20             sub xs_ok
21             {
22 4     4 1 1105615 my $cb;
23 4 50 33     89 $cb = pop if defined $_[-1] && ref $_[-1] eq 'CODE';
24 4         19 my($xs, $message) = @_;
25              
26 4 50       17 if(ref($xs))
27             {
28 4         23 my %xs = %$xs;
29 4         16 $xs = \%xs;
30             }
31             else
32             {
33 0 0       0 $xs = { xs => $xs } unless ref $xs;
34             }
35 4         17 $xs->{pxs}->{'C++'} = 1;
36 4         13 $xs->{c_ext} = 'cpp';
37              
38 4         18 my %stage = (
39             extra_compiler_flags => 'cbuilder_compile',
40             extra_linker_flags => 'cbuilder_link',
41             );
42              
43 4         76 my %cppguess = ExtUtils::CppGuess->new->module_build_options;
44 4         177968 foreach my $name (qw( extra_compiler_flags extra_linker_flags ))
45             {
46 8 50       75 next unless defined $cppguess{$name};
47 8 50       220 my @new = ref($cppguess{$name}) eq 'ARRAY' ? @{ delete $cppguess{$name} } : shellwords(delete $cppguess{$name});
  0         0  
48 8         2154 my @old = do {
49 8         97 my $value = delete $xs->{$stage{$name}}->{$name};
50 8 100       104 ref($value) eq 'ARRAY' ? @$value : shellwords($value);
51             };
52 8         301 $xs->{$stage{$name}}->{$name} = [@old, @new];
53             }
54 4         260 warn "extra Module::Build option: $_" for keys %cppguess;
55              
56 4 50       128 $cb ? Test::Alien::xs_ok($xs, $message, $cb) : Test::Alien::xs_ok($xs, $message);
57             }
58              
59             1;
60              
61             __END__