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