lib/Module/Build/t/xs.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
   5 use MBTest;
   6 use Module::Build;
   7
   8 {
   9   my ($have_c_compiler, $C_support_feature) = check_compiler();
  10
  11   if (! $C_support_feature) {
  12     plan skip_all => 'C_support not enabled';
  13   } elsif ( !$have_c_compiler ) {
  14     plan skip_all => 'C_support enabled, but no compiler found';
  15   } elsif ( $^O eq 'VMS' ) {
  16     plan skip_all => 'Child test output confuses harness';
  17   } else {
  18     plan tests => 22;
  19   }
  20 }
  21
  22 #########################
  23
  24
  25 use Cwd ();
  26 my $cwd = Cwd::cwd;
  27 my $tmp = MBTest->tmpdir;
  28
  29 use DistGen;
  30 my $dist = DistGen->new( dir => $tmp, xs => 1 );
  31 $dist->regen;
  32
  33 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
  34 my $mb = Module::Build->new_from_context;
  35
  36
  37 eval {$mb->dispatch('clean')};
  38 is $@, '';
  39
  40 eval {$mb->dispatch('build')};
  41 is $@, '';
  42
  43 {
  44   # Make sure it actually works: that we can call methods in the XS module
  45
  46   # Unfortunately, We must do this is a subprocess because some OS will not
  47   # release the handle on a dynamic lib until the attaching process terminates
  48
  49   ok $mb->run_perl_command(['-Mblib', '-M'.$dist->name, '-e1']);
  50
  51   like stdout_of( sub {$mb->run_perl_command([
  52        '-Mblib', '-M'.$dist->name,
  53        '-we', "print @{[$dist->name]}::okay()"])}), qr/ok$/;
  54
  55   like stdout_of( sub {$mb->run_perl_command([
  56        '-Mblib', '-M'.$dist->name,
  57        '-we', "print @{[$dist->name]}::version()"])}), qr/0.01$/;
  58
  59   like stdout_of( sub {$mb->run_perl_command([
  60        '-Mblib', '-M'.$dist->name,
  61        '-we', "print @{[$dist->name]}::xs_version()"])}), qr/0.01$/;
  62
  63 }
  64
  65 {
  66   # Try again in a subprocess
  67   eval {$mb->dispatch('clean')};
  68   is $@, '';
  69
  70
  71   $mb->create_build_script;
  72   my $script = $mb->build_script;
  73   ok -e $script;
  74
  75   eval {$mb->run_perl_script($script)};
  76   is $@, '';
  77 }
  78
  79 # We can't be verbose in the sub-test, because Test::Harness will
  80 # think that the output is for the top-level test.
  81 eval {$mb->dispatch('test')};
  82 is $@, '';
  83
  84 eval {$mb->dispatch('clean')};
  85 is $@, '';
  86
  87
  88 SKIP: {
  89   skip( "skipping a Unixish-only tests", 1 )
  90       unless $mb->is_unixish;
  91
  92   $mb->{config}->push(ld => "FOO=BAR ".$mb->config('ld'));
  93   eval {$mb->dispatch('build')};
  94   is $@, '';
  95   $mb->{config}->pop('ld');
  96 }
  97
  98 eval {$mb->dispatch('realclean')};
  99 is $@, '';
 100
 101 # Make sure blib/ is gone after 'realclean'
 102 ok ! -e 'blib';
 103
 104
 105 # cleanup
 106 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 107 $dist->remove;
 108
 109
 110 ########################################
 111
 112 # Try a XS distro with a deep namespace
 113
 114 $dist = DistGen->new( name => 'Simple::With::Deep::Name',
 115                       dir => $tmp, xs => 1 );
 116 $dist->regen;
 117 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 118
 119 $mb = Module::Build->new_from_context;
 120 is $@, '';
 121
 122 $mb->dispatch('build');
 123 is $@, '';
 124
 125 $mb->dispatch('test');
 126 is $@, '';
 127
 128 $mb->dispatch('realclean');
 129 is $@, '';
 130
 131 # cleanup
 132 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 133 $dist->remove;
 134
 135
 136 ########################################
 137
 138 # Try a XS distro using a flat directory structure
 139 # and a 'dist_name' instead of a 'module_name'
 140
 141 $dist = DistGen->new( name => 'Dist-Name', dir => $tmp, xs => 1 );
 142
 143 $dist->remove_file('lib/Dist-Name.pm');
 144 $dist->remove_file('lib/Dist-Name.xs');
 145
 146 $dist->change_build_pl
 147   ({
 148     dist_name         => 'Dist-Name',
 149     dist_version_from => 'Simple.pm',
 150     pm_files => { 'Simple.pm' => 'lib/Simple.pm' },
 151     xs_files => { 'Simple.xs' => 'lib/Simple.xs' },
 152   });
 153
 154 $dist->add_file('Simple.xs', <<"---");
 155 #include "EXTERN.h"
 156 #include "perl.h"
 157 #include "XSUB.h"
 158
 159 MODULE = Simple         PACKAGE = Simple
 160
 161 SV *
 162 okay()
 163     CODE:
 164         RETVAL = newSVpv( "ok", 0 );
 165     OUTPUT:
 166         RETVAL
 167 ---
 168
 169 $dist->add_file( 'Simple.pm', <<"---" );
 170 package Simple;
 171
 172 \$VERSION = '0.01';
 173
 174 require Exporter;
 175 require DynaLoader;
 176
 177 \@ISA = qw( Exporter DynaLoader );
 178 \@EXPORT_OK = qw( okay );
 179
 180 bootstrap Simple \$VERSION;
 181
 182 1;
 183
 184 __END__
 185
 186 =head1 NAME
 187
 188 Simple - Perl extension for blah blah blah
 189
 190 =head1 DESCRIPTION
 191
 192 Stub documentation for Simple.
 193
 194 =head1 AUTHOR
 195
 196 A. U. Thor, a.u.thor\@a.galaxy.far.far.away
 197
 198 =cut
 199 ---
 200 $dist->change_file('t/basic.t', <<"---");
 201 use Test::More tests => 2;
 202 use strict;
 203
 204 use Simple;
 205 ok( 1 );
 206
 207 ok( Simple::okay() eq 'ok' );
 208 ---
 209
 210 $dist->regen;
 211 chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
 212
 213
 214 $mb = Module::Build->new_from_context;
 215 is $@, '';
 216
 217 $mb->dispatch('build');
 218 is $@, '';
 219
 220 $mb->dispatch('test');
 221 is $@, '';
 222
 223 $mb->dispatch('realclean');
 224 is $@, '';
 225
 226 # cleanup
 227 chdir( $cwd ) or die "Can''t chdir to '$cwd': $!";
 228 $dist->remove;
 229
 230 use File::Path;
 231 rmtree( $tmp );