dist/XSLoader/t/XSLoader.t

   1 #!perl -T
   2
   3 use strict;
   4 use Config;
   5
   6 my $db_file;
   7 BEGIN {
   8     eval "use Test::More";
   9     if ($@) {
  10         print "1..0 # Skip: Test::More not available\n";
  11         die "Test::More not available\n";
  12     }
  13
  14     use Config;
  15     foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) {
  16         if ($Config{extensions} =~ /\b$_\b/) {
  17             $db_file = $_;
  18             last;
  19         }
  20     }
  21 }
  22
  23
  24 my %modules = (
  25     # ModuleName  => q|code to check that it was loaded|,
  26     'Cwd'        => q| ::can_ok( 'Cwd' => 'fastcwd'         ) |,  # 5.7 ?
  27     'File::Glob' => q| ::can_ok( 'File::Glob' => 'doglob'   ) |,  # 5.6
  28     $db_file     => q| ::can_ok( $db_file => 'TIEHASH'      ) |,  # 5.0
  29     'Socket'     => q| ::can_ok( 'Socket' => 'inet_aton'    ) |,  # 5.0
  30     'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3
  31 );
  32
  33 plan tests => keys(%modules) * 3 + 5;
  34
  35 # Try to load the module
  36 use_ok( 'XSLoader' );
  37
  38 # Check functions
  39 can_ok( 'XSLoader' => 'load' );
  40 can_ok( 'XSLoader' => 'bootstrap_inherit' );
  41
  42 # Check error messages
  43 eval { XSLoader::load() };
  44 like( $@, '/^XSLoader::load\(\'Your::Module\', \$Your::Module::VERSION\)/',
  45         "calling XSLoader::load() with no argument" );
  46
  47 eval q{ package Thwack; XSLoader::load('Thwack'); };
  48 if ($Config{usedl}) {
  49     like( $@, q{/^Can't locate loadable object for module Thwack in @INC/},
  50         "calling XSLoader::load() under a package with no XS part" );
  51 }
  52 else {
  53     like( $@, q{/^Can't load module Thwack, dynamic loading not available in this perl./},
  54         "calling XSLoader::load() under a package with no XS part" );
  55 }
  56
  57 # Now try to load well known XS modules
  58 my $extensions = $Config{'extensions'};
  59 $extensions =~ s|/|::|g;
  60
  61 for my $module (sort keys %modules) {
  62     my $warnings = "";
  63     local $SIG{__WARN__} = sub { $warnings = $_[0] };
  64
  65     SKIP: {
  66         skip "$module not available", 4 if $extensions !~ /\b$module\b/;
  67
  68         eval qq{ package $module; XSLoader::load('$module', "12345678"); };
  69         like( $@, "/^$module object version \\S+ does not match bootstrap parameter (?:12345678|0)/",
  70                 "calling XSLoader::load() with a XS module and an incorrect version" );
  71
  72         eval qq{ package $module; XSLoader::load('$module'); };
  73         is( $@, '',  "XSLoader::load($module)");
  74
  75         eval qq{ package $module; $modules{$module}; };
  76     }
  77 }
  78