This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
And some more DynaLoader things that should not be tested on
[perl5.git] / 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 %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
24 plan tests => 27 + keys(%modules) * 2;
25
26
27 # Try to load the module
28 use_ok( 'DynaLoader' );
29
30
31 # Check functions
32 can_ok( 'DynaLoader' => 'bootstrap'               ); # defined in Perl section
33 can_ok( 'DynaLoader' => 'dl_error'                ); # defined in XS section
34 can_ok( 'DynaLoader' => 'dl_find_symbol'          ); # defined in XS section
35 can_ok( 'DynaLoader' => 'dl_install_xsub'         ); # defined in XS section
36 can_ok( 'DynaLoader' => 'dl_load_file'            ); # defined in XS section
37 can_ok( 'DynaLoader' => 'dl_load_flags'           ); # defined in Perl section
38 can_ok( 'DynaLoader' => 'dl_undef_symbols'        ); # defined in XS section
39 SKIP: {
40     skip "unloading unsupported on VMS", 1 if $^O eq 'VMS';
41     can_ok( 'DynaLoader' => 'dl_unload_file'          ); # defined in XS section
42 }
43
44 TODO: {
45 local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
46 can_ok( 'DynaLoader' => 'dl_expandspec'           ); # defined in AutoLoaded section
47 can_ok( 'DynaLoader' => 'dl_findfile'             ); # defined in AutoLoaded section
48 can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
49 }
50
51
52 # Check error messages
53 # .. for bootstrap()
54 eval { DynaLoader::bootstrap() };
55 like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
56         "calling DynaLoader::bootstrap() with no argument" );
57
58 eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
59 like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
60         "calling DynaLoader::bootstrap() with a package without binary object" );
61
62 # .. for dl_load_file()
63 eval { DynaLoader::dl_load_file() };
64 like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
65         "calling DynaLoader::dl_load_file() with no argument" );
66
67 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
68 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
69
70 my ($dlhandle, $dlerr);
71 eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
72 $dlerr = DynaLoader::dl_error();
73 SKIP: {
74     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';
75     ok( !$dlhandle, "calling DynaLoader::dl_load_file() without an existing library should fail" );
76 }
77 ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
78
79 # Checking for any particular error messages or numeric codes
80 # is very unportable, please do not try to do that.  A failing
81 # dl_load_file() is not even guaranteed to set the $! or the $^E.
82
83 # ... dl_findfile()
84 SKIP: {
85     my @files = ();
86     eval { @files = DynaLoader::dl_findfile("c") };
87     is( $@, '', "calling dl_findfile()" );
88     # Some platforms are known to not have a "libc"
89     # (not at least by that name) that the dl_findfile()
90     # could find.
91     skip "dl_findfile test not appropriate on $^O", 1
92         if $^O =~ /(win32|vms)/i;
93     # Play safe and only try this test if this system
94     # looks pretty much Unix-like.
95     skip "dl_findfile test not appropriate on $^O", 1
96         unless -d '/usr' && -f '/bin/ls';
97     cmp_ok( scalar @files, '>=', 1, "array should contain one result result or more: libc => (@files)" );
98 }
99
100 # Now try to load well known XS modules
101 my $extensions = $Config{'extensions'};
102 $extensions =~ s|/|::|g;
103
104 for my $module (sort keys %modules) {
105     SKIP: {
106         skip "$module not available", 1 if $extensions !~ /\b$module\b/;
107         eval "use $module";
108         is( $@, '', "loading $module" );
109     }
110 }
111
112 # checking internal consistency
113 is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
114 is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
115
116 my @loaded_modules = @DynaLoader::dl_modules;
117 for my $libref (reverse @DynaLoader::dl_librefs) {
118   SKIP: {
119     skip "unloading unsupported on VMS", 2 if $^O eq 'VMS';
120     my $module = pop @loaded_modules;
121     my $r = eval { DynaLoader::dl_unload_file($libref) };
122     is( $@, '', "calling dl_unload_file() for $module" );
123     is( $r,  1, " - unload was successful" );
124   }
125 }
126