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