This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Test script for DynaLoader
[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 Errno qw(ENOENT);
13 use Test::More;
14 my %modules;
15
16 %modules = (
17    # ModuleName  => q| code to check that it was loaded |,
18     'Cwd'        => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |,         # 5.7 ?
19     'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |,   # 5.6
20     'SDBM_File'  => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |,  # 5.0
21     'Socket'     => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |,    # 5.0
22     'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |,  # 5.7.3
23 );
24
25 plan tests => 28 + keys(%modules) * 2;
26
27
28 # Try to load the module
29 use_ok( 'DynaLoader' );
30
31
32 # Check functions
33 can_ok( 'DynaLoader' => 'bootstrap'               ); # defined in Perl section
34 can_ok( 'DynaLoader' => 'dl_error'                ); # defined in XS section
35 can_ok( 'DynaLoader' => 'dl_find_symbol'          ); # defined in XS section
36 can_ok( 'DynaLoader' => 'dl_install_xsub'         ); # defined in XS section
37 can_ok( 'DynaLoader' => 'dl_load_file'            ); # defined in XS section
38 can_ok( 'DynaLoader' => 'dl_load_flags'           ); # defined in Perl section
39 can_ok( 'DynaLoader' => 'dl_undef_symbols'        ); # defined in XS section
40 can_ok( 'DynaLoader' => 'dl_unload_file'          ); # defined in XS section
41
42 TODO: {
43 local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
44 can_ok( 'DynaLoader' => 'dl_expandspec'           ); # defined in AutoLoaded section
45 can_ok( 'DynaLoader' => 'dl_findfile'             ); # defined in AutoLoaded section
46 can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
47 }
48
49
50 # Check error messages
51 # .. for bootstrap()
52 eval { DynaLoader::bootstrap() };
53 like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
54         "calling DynaLoader::bootstrap() with no argument" );
55
56 eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
57 like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
58         "calling DynaLoader::bootstrap() with a package without binary object" );
59
60 # .. for dl_load_file()
61 eval { DynaLoader::dl_load_file() };
62 like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
63         "calling DynaLoader::dl_load_file() with no argument" );
64
65 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
66 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
67
68 my ($eint,$estr,$eestr,$dlerr);
69 eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
70 $eint = 0+$!; $estr = "\Q$!\E";
71 $estr .= "|\Q$^E\E" if $^E ne $!;
72 $estr = "/$estr/";
73 $dlerr = DynaLoader::dl_error();
74 SKIP: {
75     is( $@, '', "calling DynaLoader::dl_load_file() with a package without binary object" )
76         or skip "Errvalue irrelevent after eval failure (this should not happen)", 2;
77     is( $eint, ENOENT, "checking errno value" );
78     like( $dlerr, $estr, "checking error message returned by dl_error()" );
79 }
80
81
82 # ... dl_findfile()
83 SKIP: {
84     my @files = ();
85     eval { @files = DynaLoader::dl_findfile("c") };
86     is( $@, '', "calling dl_findfile()" );
87     skip "dl_findfile test not appropriate on Win32", 1
88         if $^O =~ /win32/i;
89     cmp_ok( scalar @files, '>=', 1, " - array should contain one result result or more: libc => (@files)" );
90 }
91
92 # Now try to load well known XS modules
93 my $extensions = $Config{'extensions'};
94 $extensions =~ s|/|::|g;
95
96 for my $module (sort keys %modules) {
97     SKIP: {
98         skip "$module not available", 1 if $extensions !~ /\b$module\b/;
99         eval "use $module";
100         is( $@, '', "loading $module" );
101     }
102 }
103
104 # checking internal consistency
105 is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
106 is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
107
108 my @loaded_modules = @DynaLoader::dl_modules;
109 for my $libref (reverse @DynaLoader::dl_librefs) {
110     my $module = pop @loaded_modules;
111     my $r = eval { DynaLoader::dl_unload_file($libref) };
112     is( $@, '', "calling dl_unload_file() for $module" );
113     is( $r,  1, " - unload was successful" );
114 }
115