Test script for DynaLoader

Message-ID: <1147963560.446c88a8891e1@imp1-g19.free.fr>

p4raw-id: //depot/perl@28226

diff --git a/MANIFEST b/MANIFEST
index 2c3fc2e..e90a084 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -559,6 +559,7 @@ ext/DynaLoader/hints/netbsd.pl      Hint for DynaLoader for named architecture
 ext/DynaLoader/hints/openbsd.pl        Hint for DynaLoader for named architecture
 ext/DynaLoader/Makefile.PL     Dynamic Loader makefile writer
 ext/DynaLoader/README          Dynamic Loader notes and intro
+ext/DynaLoader/t/DynaLoader.t  See if DynaLoader works
 ext/DynaLoader/t/XSLoader.t    See if XSLoader works
 ext/DynaLoader/XSLoader_pm.PL  Simple XS Loader perl module
 ext/Encode/AUTHORS             List of authors

diff --git a/ext/DynaLoader/t/DynaLoader.t b/ext/DynaLoader/t/DynaLoader.t
new file mode 100644 (file)
index 0000000..bc96fab
--- /dev/null
+++ b/ext/DynaLoader/t/DynaLoader.t
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -wT
+
+BEGIN {
+    if( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+}
+
+use strict;
+use Config;
+use Test::More;
+my %modules;
+
+%modules = (
+   # ModuleName  => q| code to check that it was loaded |,
+    'Cwd'        => q| ::is( ref Cwd->can('fastcwd'),'CODE' ) |,         # 5.7 ?
+    'File::Glob' => q| ::is( ref File::Glob->can('doglob'),'CODE' ) |,   # 5.6
+    'SDBM_File'  => q| ::is( ref SDBM_File->can('TIEHASH'), 'CODE' ) |,  # 5.0
+    'Socket'     => q| ::is( ref Socket->can('inet_aton'),'CODE' ) |,    # 5.0
+    'Time::HiRes'=> q| ::is( ref Time::HiRes->can('usleep'),'CODE' ) |,  # 5.7.3
+);
+
+plan tests => 27 + keys(%modules) * 2;
+
+
+# Try to load the module
+use_ok( 'DynaLoader' );
+
+
+# Check functions
+can_ok( 'DynaLoader' => 'bootstrap'               ); # defined in Perl section
+can_ok( 'DynaLoader' => 'dl_error'                ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_find_symbol'          ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_install_xsub'         ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_load_file'            ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_load_flags'           ); # defined in Perl section
+can_ok( 'DynaLoader' => 'dl_undef_symbols'        ); # defined in XS section
+can_ok( 'DynaLoader' => 'dl_unload_file'          ); # defined in XS section
+
+TODO: {
+local $TODO = "Test::More::can_ok() seems to have trouble dealing with AutoLoaded functions";
+can_ok( 'DynaLoader' => 'dl_expandspec'           ); # defined in AutoLoaded section
+can_ok( 'DynaLoader' => 'dl_findfile'             ); # defined in AutoLoaded section
+can_ok( 'DynaLoader' => 'dl_find_symbol_anywhere' ); # defined in AutoLoaded section
+}
+
+
+# Check error messages
+# .. for bootstrap()
+eval { DynaLoader::bootstrap() };
+like( $@, q{/^Usage: DynaLoader::bootstrap\(module\)/},
+        "calling DynaLoader::bootstrap() with no argument" );
+
+eval { package egg_bacon_sausage_and_spam; DynaLoader::bootstrap("egg_bacon_sausage_and_spam") };
+like( $@, q{/^Can't locate loadable object for module egg_bacon_sausage_and_spam/},
+        "calling DynaLoader::bootstrap() with a package without binary object" );
+
+# .. for dl_load_file()
+eval { DynaLoader::dl_load_file() };
+like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
+        "calling DynaLoader::dl_load_file() with no argument" );
+
+eval { DynaLoader::dl_load_file(undef) };
+is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
+
+eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
+is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );
+like( DynaLoader::dl_error(), q{/^egg_bacon_sausage_and_spam: cannot open shared object file:/}, 
+        "calling DynaLoader::dl_load_file() with a package without binary object" );
+
+# ... dl_findfile()
+my @files = ();
+eval { @files = DynaLoader::dl_findfile("c") };
+is( $@, '', "calling dl_findfile()" );
+cmp_ok( scalar @files, '>=', 1, " - array should contain one result result or more: libc => (@files)" );
+
+
+# Now try to load well known XS modules
+my $extensions = $Config{'extensions'};
+$extensions =~ s|/|::|g;
+
+for my $module (sort keys %modules) {
+    SKIP: {
+        skip "$module not available", 2 if $extensions !~ /\b$module\b/;
+        eval "use $module";
+        is( $@, '', "loading $module" );
+    }
+}
+
+# checking internal consistency
+is( scalar @DynaLoader::dl_librefs, scalar keys %modules, "checking number of items in \@dl_librefs" );
+is( scalar @DynaLoader::dl_modules, scalar keys %modules, "checking number of items in \@dl_modules" );
+
+my @loaded_modules = @DynaLoader::dl_modules;
+for my $libref (reverse @DynaLoader::dl_librefs) {
+    my $module = pop @loaded_modules;
+    my $r = eval { DynaLoader::dl_unload_file($libref) };
+    is( $@, '', "calling dl_unload_file() for $module" );
+    is( $r,  1, " - unload was successful" );
+}
+