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