"Fossies" - the Fresh Open Source Software Archive

Member "perl-5.32.1/dist/ExtUtils-ParseXS/t/003-usage.t" (18 Dec 2020, 2731 Bytes) of package /linux/misc/perl-5.32.1.tar.xz:

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