This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test script for DynaLoader
[perl5.git] / ext / DynaLoader / t / DynaLoader.t
CommitLineData
51254d33
AT
1#!/usr/bin/perl -wT
2
3BEGIN {
4 if( $ENV{PERL_CORE} ) {
5 chdir 't';
6 @INC = '../lib';
7 }
8}
9
10use strict;
11use Config;
12use Test::More;
13my %modules;
14
15%modules = (
16 # ModuleName => q| code to check that it was loaded |,
17 'Cwd' => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |, # 5.7 ?
18 'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |, # 5.6
19 'SDBM_File' => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |, # 5.0
20 'Socket' => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |, # 5.0
21 'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |, # 5.7.3
22);
23
24plan tests => 27 + keys(%modules) * 2;
25
26
27# Try to load the module
28use_ok( 'DynaLoader' );
29
30
31# Check functions
32can_ok( 'DynaLoader' => 'bootstrap' ); # defined in Perl section
33can_ok( 'DynaLoader' => 'dl_error' ); # defined in XS section
34can_ok( 'DynaLoader' => 'dl_find_symbol' ); # defined in XS section
35can_ok( 'DynaLoader' => 'dl_install_xsub' ); # defined in XS section
36can_ok( 'DynaLoader' => 'dl_load_file' ); # defined in XS section
37can_ok( 'DynaLoader' => 'dl_load_flags' ); # defined in Perl section
38can_ok( 'DynaLoader' => 'dl_undef_symbols' ); # defined in XS section
39can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
40
41TODO: {
42local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
43can_ok( 'DynaLoader' => 'dl_expandspec' ); # defined in AutoLoaded section
44can_ok( 'DynaLoader' => 'dl_findfile' ); # defined in AutoLoaded section
45can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
46}
47
48
49# Check error messages
50# .. for bootstrap()
51eval { DynaLoader::bootstrap() };
52like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
53 "calling DynaLoader::bootstrap() with no argument" );
54
55eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
56like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
57 "calling DynaLoader::bootstrap() with a package without binary object" );
58
59# .. for dl_load_file()
60eval { DynaLoader::dl_load_file() };
61like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
62 "calling DynaLoader::dl_load_file() with no argument" );
63
64eval { DynaLoader::dl_load_file(undef) };
65is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
66
67eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
68is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );
69like( DynaLoader::dl_error(), q{/^egg_bacon_sausage_and_spam: cannot open shared object file:/},
70 "calling DynaLoader::dl_load_file() with a package without binary object" );
71
72# ... dl_findfile()
73my @files = ();
74eval { @files = DynaLoader::dl_findfile("c") };
75is( $@, '', "calling dl_findfile()" );
76cmp_ok( scalar @files, '>=', 1, " - array should contain one result result or more: libc => (@files)" );
77
78
79# Now try to load well known XS modules
80my $extensions = $Config{'extensions'};
81$extensions =~ s|/|::|g;
82
83for my $module (sort keys %modules) {
84 SKIP: {
85 skip "$module not available", 2 if $extensions !~ /\b$module\b/;
86 eval "use $module";
87 is( $@, '', "loading $module" );
88 }
89}
90
91# checking internal consistency
92is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
93is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
94
95my @loaded_modules = @DynaLoader::dl_modules;
96for my $libref (reverse @DynaLoader::dl_librefs) {
97 my $module = pop @loaded_modules;
98 my $r = eval { DynaLoader::dl_unload_file($libref) };
99 is( $@, '', "calling dl_unload_file() for $module" );
100 is( $r, 1, " - unload was successful" );
101}
102