ext/DynaLoader/t/DynaLoader.t

   1 #!/usr/bin/perl -wT
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = '../lib';
   7     }
   8 }
   9
  10 use strict;
  11 use Config;
  12 use Errno qw(ENOENT);
  13 use Test::More;
  14 my %modules;
  15
  16 %modules = (
  17    # ModuleName  => q| code to check that it was loaded |,
  18     'Cwd'        => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |,         # 5.7 ?
  19     'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |,   # 5.6
  20     'SDBM_File'  => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |,  # 5.0
  21     'Socket'     => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |,    # 5.0
  22     'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |,  # 5.7.3
  23 );
  24
  25 plan tests => 28 + keys(%modules) * 2;
  26
  27
  28 # Try to load the module
  29 use_ok( 'DynaLoader' );
  30
  31
  32 # Check functions
  33 can_ok( 'DynaLoader' => 'bootstrap'               ); # defined in Perl section
  34 can_ok( 'DynaLoader' => 'dl_error'                ); # defined in XS section
  35 can_ok( 'DynaLoader' => 'dl_find_symbol'          ); # defined in XS section
  36 can_ok( 'DynaLoader' => 'dl_install_xsub'         ); # defined in XS section
  37 can_ok( 'DynaLoader' => 'dl_load_file'            ); # defined in XS section
  38 can_ok( 'DynaLoader' => 'dl_load_flags'           ); # defined in Perl section
  39 can_ok( 'DynaLoader' => 'dl_undef_symbols'        ); # defined in XS section
  40 can_ok( 'DynaLoader' => 'dl_unload_file'          ); # defined in XS section
  41
  42 TODO: {
  43 local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
  44 can_ok( 'DynaLoader' => 'dl_expandspec'           ); # defined in AutoLoaded section
  45 can_ok( 'DynaLoader' => 'dl_findfile'             ); # defined in AutoLoaded section
  46 can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
  47 }
  48
  49
  50 # Check error messages
  51 # .. for bootstrap()
  52 eval { DynaLoader::bootstrap() };
  53 like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
  54         "calling DynaLoader::bootstrap() with no argument" );
  55
  56 eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
  57 like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
  58         "calling DynaLoader::bootstrap() with a package without binary object" );
  59
  60 # .. for dl_load_file()
  61 eval { DynaLoader::dl_load_file() };
  62 like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
  63         "calling DynaLoader::dl_load_file() with no argument" );
  64
  65 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
  66 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
  67
  68 eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
  69 is( $@, '', "calling DynaLoader::dl_load_file() with a package without binary object" );
  70 is( 0+$!, ENOENT, "checking errno value" );
  71 like( DynaLoader::dl_error(), "/$!/", "checking error message returned by dl_error()" );
  72
  73 # ... dl_findfile()
  74 my @files = ();
  75 eval { @files = DynaLoader::dl_findfile("c") };
  76 is( $@, '', "calling dl_findfile()" );
  77 cmp_ok( scalar @files, '>=', 1, " - array should contain one result result or more: libc => (@files)" );
  78
  79
  80 # Now try to load well known XS modules
  81 my $extensions = $Config{'extensions'};
  82 $extensions =~ s|/|::|g;
  83
  84 for my $module (sort keys %modules) {
  85     SKIP: {
  86         skip "$module not available", 2 if $extensions !~ /\b$module\b/;
  87         eval "use $module";
  88         is( $@, '', "loading $module" );
  89     }
  90 }
  91
  92 # checking internal consistency
  93 is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
  94 is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
  95
  96 my @loaded_modules = @DynaLoader::dl_modules;
  97 for my $libref (reverse @DynaLoader::dl_librefs) {
  98     my $module = pop @loaded_modules;
  99     my $r = eval { DynaLoader::dl_unload_file($libref) };
 100     is( $@, '', "calling dl_unload_file() for $module" );
 101     is( $r,  1, " - unload was successful" );
 102 }
 103