dist/ExtUtils-ParseXS/t/002-more.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use Test::More;
   5 use Config;
   6 use DynaLoader;
   7 use ExtUtils::CBuilder;
   8 use attributes;
   9 use overload;
  10
  11 plan tests => 25;
  12
  13 my ($source_file, $obj_file, $lib_file);
  14
  15 require_ok( 'ExtUtils::ParseXS' );
  16 ExtUtils::ParseXS->import('process_file');
  17
  18 chdir 't' or die "Can't chdir to t/, $!";
  19
  20 use Carp; $SIG{__WARN__} = \&Carp::cluck;
  21
  22 #########################
  23
  24 $source_file = 'XSMore.c';
  25
  26 # Try sending to file
  27 ExtUtils::ParseXS->process_file(
  28         filename => 'XSMore.xs',
  29         output   => $source_file,
  30 );
  31 ok -e $source_file, "Create an output file";
  32
  33 my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE};
  34 my $b = ExtUtils::CBuilder->new(quiet => $quiet);
  35
  36 SKIP: {
  37   skip "no compiler available", 2
  38     if ! $b->have_compiler;
  39   $obj_file = $b->compile( source => $source_file );
  40   ok $obj_file, "ExtUtils::CBuilder::compile() returned true value";
  41   ok -e $obj_file, "Make sure $obj_file exists";
  42 }
  43
  44 SKIP: {
  45   skip "no dynamic loading", 21
  46     if !$b->have_compiler || !$Config{usedl};
  47   my $module = 'XSMore';
  48   $lib_file = $b->link( objects => $obj_file, module_name => $module );
  49   ok $lib_file, "ExtUtils::CBuilder::link() returned true value";
  50   ok -e $lib_file,  "Make sure $lib_file exists";
  51
  52   eval{
  53     package XSMore;
  54     our $VERSION = 42;
  55     our $boot_ok;
  56     DynaLoader::bootstrap_inherit(__PACKAGE__, $VERSION); # VERSIONCHECK disabled
  57
  58     sub new{ bless {}, shift }
  59   };
  60   is $@, '', "No error message recorded, as expected";
  61   is ExtUtils::ParseXS::report_error_count(), 0, 'ExtUtils::ParseXS::errors()';
  62
  63   is $XSMore::boot_ok, 100, 'the BOOT keyword';
  64
  65   ok XSMore::include_ok(), 'the INCLUDE keyword';
  66   is prototype(\&XSMore::include_ok), "", 'the PROTOTYPES keyword';
  67
  68   is prototype(\&XSMore::prototype_ssa), '$$@', 'the PROTOTYPE keyword';
  69
  70   is_deeply [attributes::get(\&XSMore::attr_method)], [qw(method)], 'the ATTRS keyword';
  71   is prototype(\&XSMore::attr_method), '$;@', 'ATTRS with prototype';
  72
  73   is XSMore::return_1(), 1, 'the CASE keyword (1)';
  74   is XSMore::return_2(), 2, 'the CASE keyword (2)';
  75   is prototype(\&XSMore::return_1), "", 'ALIAS with prototype (1)';
  76   is prototype(\&XSMore::return_2), "", 'ALIAS with prototype (2)';
  77
  78   is XSMore::arg_init(200), 200, 'argument init';
  79
  80   ok overload::Overloaded(XSMore->new), 'the FALLBACK keyword';
  81   is abs(XSMore->new), 42, 'the OVERLOAD keyword';
  82
  83   my @a;
  84   XSMore::hook(\@a);
  85   is_deeply \@a, [qw(INIT CODE POSTCALL CLEANUP)], 'the INIT & POSTCALL & CLEANUP keywords';
  86
  87   is_deeply [XSMore::outlist()], [ord('a'), ord('b')], 'the OUTLIST keyword';
  88
  89   is XSMore::len("foo"), 3, 'the length keyword';
  90
  91   is XSMore::sum(5, 9), 14, 'the INCLUDE_COMMAND directive';
  92
  93   # Win32 needs to close the DLL before it can unlink it, but unfortunately
  94   # dl_unload_file was missing on Win32 prior to perl change #24679!
  95   if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) {
  96     for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) {
  97       if ($DynaLoader::dl_modules[$i] eq $module) {
  98         DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]);
  99         last;
 100       }
 101     }
 102   }
 103 }
 104
 105 unless ($ENV{PERL_NO_CLEANUP}) {
 106   for ( $obj_file, $lib_file, $source_file) {
 107     next unless defined $_;
 108     1 while unlink $_;
 109   }
 110 }