"Fossies" - the Fresh Open Source Software Archive

Member "Module-Build-0.4229/t/xs.t" (15 Apr 2019, 4559 Bytes) of package /linux/privat/Module-Build-0.4229.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "xs.t": 0.4216_vs_0.4218.

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