1#!perl -T 2 3use strict; 4use Config; 5 6my $db_file; 7BEGIN { 8 if (not eval "use Test::More; 1") { 9 print "1..0 # Skip: Test::More not available\n"; 10 die "Test::More not available\n"; 11 } 12 13 plan(skip_all => "these tests needs Perl 5.5+") if $] < 5.005; 14 15 use Config; 16 foreach (qw/SDBM_File GDBM_File ODBM_File NDBM_File DB_File/) { 17 if ($Config{extensions} =~ /\b$_\b/) { 18 $db_file = $_; 19 last; 20 } 21 } 22} 23 24 25my %modules = ( 26 # ModuleName => q|code to check that it was loaded|, 27 'Cwd' => q| ::can_ok( 'Cwd' => 'fastcwd' ) |, # 5.7 ? 28 'File::Glob' => q| ::can_ok( 'File::Glob' => # 5.6 29 $] > 5.014 30 ? 'bsd_glob' : 'doglob') |, 31 $db_file => q| ::can_ok( $db_file => 'TIEHASH' ) |, # 5.0 32 'Socket' => q| ::can_ok( 'Socket' => 'inet_aton' ) |, # 5.0 33 'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3 34); 35 36plan tests => keys(%modules) * 3 + 8; 37 38# Try to load the module 39use_ok( 'XSLoader' ); 40 41# Check functions 42can_ok( 'XSLoader' => 'load' ); 43can_ok( 'XSLoader' => 'bootstrap_inherit' ); 44 45# Check error messages 46my @cases = ( 47 [ 'Thwack', 'package Thwack; XSLoader::load(); 1' ], 48 [ 'Zlott' , 'package Thwack; XSLoader::load("Zlott"); 1' ], 49); 50 51for my $case (@cases) { 52 my ($should_load, $codestr) = @$case; 53 my $diag; 54 55 # determine the expected diagnostic 56 if ($Config{usedl}) { 57 if ($case->[0] eq "Thwack" and ($] == 5.008004 or $] == 5.008005)) { 58 # these versions had bugs with chained C<goto &> 59 $diag = "Usage: DynaLoader::bootstrap\\(module\\)"; 60 } else { 61 # normal diagnostic for a perl with dynamic loading 62 $diag = "Can't locate loadable object for module $should_load in \@INC"; 63 } 64 } else { 65 # a perl with no dynamic loading 66 $diag = "Can't load module $should_load, dynamic loading not available in this perl."; 67 } 68 69 is(eval $codestr, undef, "eval '$codestr' should die"); 70 like($@, qr/^$diag/, "calling XSLoader::load() under a package with no XS part"); 71} 72 73# Now try to load well known XS modules 74my $extensions = $Config{'extensions'}; 75$extensions =~ s|/|::|g; 76 77for my $module (sort keys %modules) { 78 SKIP: { 79 skip "$module not available", 3 if $extensions !~ /\b$module\b/; 80 81 eval qq{ package $module; XSLoader::load('$module', "12345678"); }; 82 like( $@, "/^$module object version \\S+ does not match bootstrap parameter 12345678/", 83 "calling XSLoader::load() with a XS module and an incorrect version" ); 84 85 eval qq{ package $module; XSLoader::load('$module'); }; 86 is( $@, '', "XSLoader::load($module)"); 87 88 eval qq{ package $module; $modules{$module}; }; 89 } 90} 91 92SKIP: { 93 skip "Needs 5.15.6", 1 unless $] > 5.0150051; 94 skip "List::Util not available", 1 if $extensions !~ /\bList::Util\b/; 95 eval 'package List::Util; XSLoader::load(__PACKAGE__, "version")'; 96 like $@, "/^Invalid version format/", 97 'correct error msg for invalid versions'; 98} 99