ext/DynaLoader/t/XSLoader.t

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