ext/DynaLoader/t/DynaLoader.t

   1 #!/usr/bin/perl -wT
   2
   3 use strict;
   4 use Config;
   5 use Test::More;
   6 my %modules;
   7
   8 my $db_file;
   9 BEGIN {
  10     use Config;
  11     foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
  12         if ($Config{extensions} =~ /\b$_\b/) {
  13             $db_file = $_;
  14             last;
  15         }
  16     }
  17 }
  18
  19 %modules = (
  20    # ModuleName  => q| code to check that it was loaded |,
  21     'List::Util' => q| ::is( ref List::Util->can('first'), 'CODE' ) |,  # 5.7.2
  22     'Cwd'        => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |,         # 5.7 ?
  23     'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |,   # 5.6
  24     $db_file     => q| ::is( ref $db_file->can('TIEHASH'), 'CODE' ) |,  # 5.0
  25     'Socket'     => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |,    # 5.0
  26     'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |,  # 5.7.3
  27 );
  28
  29 plan tests => 22 + keys(%modules) * 3;
  30
  31
  32 # Try to load the module
  33 use_ok( 'DynaLoader' );
  34
  35 # Some tests need to be skipped on old Darwin versions.
  36 # Commit ce12ed1954 added the skip originally, without specifying which
  37 # darwin version needed it.  I know OS X 10.6 (Snow Leopard; darwin 10)
  38 # supports it, so skip anything before that.
  39 my $old_darwin = $^O eq 'darwin' && ($Config{osvers} =~ /^(\d+)/)[0] < 10;
  40
  41 # Check functions
  42 can_ok( 'DynaLoader' => 'bootstrap'               ); # defined in Perl section
  43 can_ok( 'DynaLoader' => 'dl_load_flags'           ); # defined in Perl section
  44 can_ok( 'DynaLoader' => 'dl_error'                ); # defined in XS section
  45 if ($Config{usedl}) {
  46     can_ok( 'DynaLoader' => 'dl_find_symbol'      ); # defined in XS section
  47     can_ok( 'DynaLoader' => 'dl_install_xsub'     ); # defined in XS section
  48     can_ok( 'DynaLoader' => 'dl_load_file'        ); # defined in XS section
  49     can_ok( 'DynaLoader' => 'dl_undef_symbols'    ); # defined in XS section
  50     SKIP: {
  51         skip "unloading unsupported on $^O", 1 if ($old_darwin || $^O eq 'VMS');
  52         can_ok( 'DynaLoader' => 'dl_unload_file'  ); # defined in XS section
  53     }
  54 } else {
  55     foreach my $symbol (qw(dl_find_symbol dl_install_sub dl_load_file
  56                            dl_undef_symbols dl_unload_file)) {
  57         is(DynaLoader->can($symbol), undef,
  58            "Without dynamic loading, DynaLoader should not have $symbol");
  59     }
  60 }
  61
  62 can_ok( 'DynaLoader' => 'dl_expandspec'           );
  63 can_ok( 'DynaLoader' => 'dl_findfile'             );
  64 can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' );
  65
  66
  67 # Check error messages
  68 # .. for bootstrap()
  69 eval { DynaLoader::bootstrap() };
  70 like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
  71         "calling DynaLoader::bootstrap() with no argument" );
  72
  73 eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
  74 if ($Config{usedl}) {
  75     like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
  76         "calling DynaLoader::bootstrap() with a package without binary object" );
  77 } else {
  78      like( $@, q{/^Can't load module egg_bacon_sausage_and_spam/},
  79         "calling DynaLoader::bootstrap() with a package without binary object" );
  80 }
  81
  82 # .. for dl_load_file()
  83 SKIP: {
  84     skip "no dl_load_file with dl_none.xs", 2 unless $Config{usedl};
  85     eval { DynaLoader::dl_load_file() };
  86     like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
  87             "calling DynaLoader::dl_load_file() with no argument" );
  88
  89     eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
  90     is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
  91 }
  92
  93 my ($dlhandle, $dlerr);
  94 eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
  95 $dlerr = DynaLoader::dl_error();
  96 SKIP: {
  97     skip "dl_load_file() does not attempt to load file on VMS (and thus does not fail) when \@dl_require_symbols is empty", 1 if $^O eq 'VMS';
  98     ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" );
  99 }
 100 ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
 101
 102 # Checking for any particular error messages or numeric codes
 103 # is very unportable, please do not try to do that.  A failing
 104 # dl_load_file() is not even guaranteed to set the $! or the $^E.
 105
 106 # ... dl_findfile()
 107 SKIP: {
 108     my @files = ();
 109     eval { @files = DynaLoader::dl_findfile("c") };
 110     is( $@, '', "calling dl_findfile()" );
 111     # Some platforms are known to not have a "libc"
 112     # (not at least by that name) that the dl_findfile()
 113     # could find.
 114     skip "dl_findfile test not appropriate on $^O", 1
 115         if $^O =~ /(win32|vms|openbsd|cygwin)/i;
 116     # Play safe and only try this test if this system
 117     # looks pretty much Unix-like.
 118     skip "dl_findfile test not appropriate on $^O", 1
 119         unless -d '/usr' && -f '/bin/ls';
 120     cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" );
 121 }
 122
 123 # Now try to load well known XS modules
 124 my $extensions = $Config{'dynamic_ext'};
 125 $extensions =~ s|/|::|g;
 126
 127 for my $module (sort keys %modules) {
 128     SKIP: {
 129         if ($extensions !~ /\b$module\b/) {
 130             delete($modules{$module});
 131             skip "$module not available", 3;
 132         }
 133         eval "use $module";
 134         is( $@, '', "loading $module" );
 135     }
 136 }
 137
 138 # checking internal consistency
 139 is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
 140 is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
 141
 142 my @loaded_modules = @DynaLoader::dl_modules;
 143 for my $libref (reverse @DynaLoader::dl_librefs) {
 144   SKIP: {
 145     skip "unloading unsupported on $^O", 2 if ($old_darwin || $^O eq 'VMS');
 146     my $module = pop @loaded_modules;
 147     skip "File::Glob sets PL_opfreehook", 2 if $module eq 'File::Glob';
 148     my $r = eval { DynaLoader::dl_unload_file($libref) };
 149     is( $@, '', "calling dl_unload_file() for $module" );
 150     is( $r,  1, " - unload was successful" );
 151   }
 152 }
 153