This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The DynaLoader test isn't happy with OpenBSD's libc.so.39.3.
[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
f3c90b36 24plan tests => 27 + keys(%modules) * 2;
51254d33
AT
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
a555bf5f 39SKIP: {
ce12ed19 40 skip "unloading unsupported on $^O", 1 if ($^O eq 'VMS' || $^O eq 'darwin');
a555bf5f
CB
41 can_ok( 'DynaLoader' => 'dl_unload_file' ); # defined in XS section
42}
51254d33
AT
43
44TODO: {
45local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
46can_ok( 'DynaLoader' => 'dl_expandspec' ); # defined in AutoLoaded section
47can_ok( 'DynaLoader' => 'dl_findfile' ); # defined in AutoLoaded section
48can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
49}
50
51
52# Check error messages
53# .. for bootstrap()
54eval { DynaLoader::bootstrap() };
55like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
56 "calling DynaLoader::bootstrap() with no argument" );
57
58eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
59like( $@, 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()
63eval { DynaLoader::dl_load_file() };
64like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
65 "calling DynaLoader::dl_load_file() with no argument" );
66
69c6e315 67eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
51254d33
AT
68is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" ); # is this expected ?
69
f3c90b36
JH
70my ($dlhandle, $dlerr);
71eval { $dlhandle = DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
c3026122 72$dlerr = DynaLoader::dl_error();
a555bf5f
CB
73SKIP: {
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}
f3c90b36 77ok( defined $dlerr, "dl_error() returning an error message: '$dlerr'" );
51254d33 78
f3c90b36
JH
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.
51254d33 82
c3026122
YO
83# ... dl_findfile()
84SKIP: {
85 my @files = ();
86 eval { @files = DynaLoader::dl_findfile("c") };
87 is( $@, '', "calling dl_findfile()" );
f3c90b36
JH
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
267f5f64 92 if $^O =~ /(win32|vms|openbsd)/i;
f3c90b36
JH
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)" );
c3026122 98}
51254d33
AT
99
100# Now try to load well known XS modules
101my $extensions = $Config{'extensions'};
102$extensions =~ s|/|::|g;
103
104for my $module (sort keys %modules) {
105 SKIP: {
c3026122 106 skip "$module not available", 1 if $extensions !~ /\b$module\b/;
51254d33
AT
107 eval "use $module";
108 is( $@, '', "loading $module" );
109 }
110}
111
112# checking internal consistency
113is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
114is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
115
116my @loaded_modules = @DynaLoader::dl_modules;
117for my $libref (reverse @DynaLoader::dl_librefs) {
a555bf5f 118 SKIP: {
ce12ed19 119 skip "unloading unsupported on $^O", 2 if ($^O eq 'VMS' || $^O eq 'darwin');
51254d33
AT
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" );
a555bf5f 124 }
51254d33
AT
125}
126