003-usage.t revision 1.1.1.1
1#!/usr/bin/perl 2 3use strict; 4use Test::More; 5use Config; 6use DynaLoader; 7use ExtUtils::CBuilder; 8 9if ( $] < 5.008 ) { 10 plan skip_all => "INTERFACE keyword support broken before 5.8"; 11} 12else { 13 plan tests => 24; 14} 15 16my ($source_file, $obj_file, $lib_file, $module); 17 18require_ok( 'ExtUtils::ParseXS' ); 19ExtUtils::ParseXS->import('process_file'); 20 21chdir 't' or die "Can't chdir to t/, $!"; 22 23use Carp; $SIG{__WARN__} = \&Carp::cluck; 24 25######################### 26 27$source_file = 'XSUsage.c'; 28 29# Try sending to file 30process_file(filename => 'XSUsage.xs', output => $source_file); 31ok -e $source_file, "Create an output file"; 32 33# TEST doesn't like extraneous output 34my $quiet = $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE}; 35 36# Try to compile the file! Don't get too fancy, though. 37my $b = ExtUtils::CBuilder->new(quiet => $quiet); 38 39SKIP: { 40 skip "no compiler available", 2 41 if ! $b->have_compiler; 42 $module = 'XSUsage'; 43 44 $obj_file = $b->compile( source => $source_file ); 45 ok $obj_file; 46 ok -e $obj_file, "Make sure $obj_file exists"; 47} 48SKIP: { 49 skip "no dynamic loading", 20 50 if !$b->have_compiler || !$Config{usedl}; 51 52 $lib_file = $b->link( objects => $obj_file, module_name => $module ); 53 ok $lib_file; 54 ok -e $lib_file, "Make sure $lib_file exists"; 55 56 eval {require XSUsage}; 57 is $@, ''; 58 59 # The real tests here - for each way of calling the functions, call with the 60 # wrong number of arguments and check the Usage line is what we expect 61 62 eval { XSUsage::one(1) }; 63 ok $@; 64 ok $@ =~ /^Usage: XSUsage::one/; 65 66 eval { XSUsage::two(1) }; 67 ok $@; 68 ok $@ =~ /^Usage: XSUsage::two/; 69 70 eval { XSUsage::two_x(1) }; 71 ok $@; 72 ok $@ =~ /^Usage: XSUsage::two_x/; 73 74 eval { FOO::two(1) }; 75 ok $@; 76 ok $@ =~ /^Usage: FOO::two/; 77 78 eval { XSUsage::three(1) }; 79 ok $@; 80 ok $@ =~ /^Usage: XSUsage::three/; 81 82 eval { XSUsage::four(1) }; 83 ok !$@; 84 85 eval { XSUsage::five() }; 86 ok $@; 87 ok $@ =~ /^Usage: XSUsage::five/; 88 89 eval { XSUsage::six() }; 90 ok !$@; 91 92 eval { XSUsage::six(1) }; 93 ok !$@; 94 95 eval { XSUsage::six(1,2) }; 96 ok $@; 97 ok $@ =~ /^Usage: XSUsage::six/; 98 99 # Win32 needs to close the DLL before it can unlink it, but unfortunately 100 # dl_unload_file was missing on Win32 prior to perl change #24679! 101 if ($^O eq 'MSWin32' and defined &DynaLoader::dl_unload_file) { 102 for (my $i = 0; $i < @DynaLoader::dl_modules; $i++) { 103 if ($DynaLoader::dl_modules[$i] eq $module) { 104 DynaLoader::dl_unload_file($DynaLoader::dl_librefs[$i]); 105 last; 106 } 107 } 108 } 109} 110 111unless ($ENV{PERL_NO_CLEANUP}) { 112 for ( $obj_file, $lib_file, $source_file) { 113 next unless defined $_; 114 1 while unlink $_; 115 } 116} 117 118