This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: [PATCH] Test script for DynaLoader
authorYves Orton <demerphq@gmail.com>
Thu, 25 May 2006 13:20:53 +0000 (15:20 +0200)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Fri, 26 May 2006 13:01:35 +0000 (13:01 +0000)
Message-ID: <9b18b3110605250420m7431bfbeve44aada2025264f7@mail.gmail.com>

p4raw-id: //depot/perl@28308

ext/DynaLoader/t/DynaLoader.t

index 841fa22..23af852 100644 (file)
@@ -65,17 +65,29 @@ like( $@, q{/^Usage: DynaLoader::dl_load_file\(filename, flags=0\)/},
 eval { no warnings 'uninitialized'; DynaLoader::dl_load_file(undef) };
 is( $@, '', "calling DynaLoader::dl_load_file() with undefined argument" );     # is this expected ?
 
+my ($eint,$estr,$eestr,$dlerr);
 eval { DynaLoader::dl_load_file("egg_bacon_sausage_and_spam") };
-is( $@, '', "calling DynaLoader::dl_load_file() with a package without binary object" );
-is( 0+$!, ENOENT, "checking errno value" );
-like( DynaLoader::dl_error(), "/$!/", "checking error message returned by dl_error()" );
+$eint = 0+$!; $estr = "\Q$!\E";
+$estr .= "|\Q$^E\E" if $^E ne $!;
+$estr = "/$estr/";
+$dlerr = DynaLoader::dl_error();
+SKIP: {
+    is( $@, '', "calling DynaLoader::dl_load_file() with a package without binary object" )
+        or skip "Errvalue irrelevent after eval failure (this should not happen)", 2;
+    is( $eint, ENOENT, "checking errno value" );
+    like( $dlerr, $estr, "checking error message returned by dl_error()" );
+}
 
-# ... 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)" );
 
+# ... dl_findfile()
+SKIP: {
+    my @files = ();
+    eval { @files = DynaLoader::dl_findfile("c") };
+    is( $@, '', "calling dl_findfile()" );
+    skip "dl_findfile test not appropriate on Win32", 1
+       if $^O =~ /win32/i;
+    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'};
@@ -83,7 +95,7 @@ $extensions =~ s|/|::|g;
 
 for my $module (sort keys %modules) {
     SKIP: {
-        skip "$module not available", 2 if $extensions !~ /\b$module\b/;
+        skip "$module not available", 1 if $extensions !~ /\b$module\b/;
         eval "use $module";
         is( $@, '', "loading $module" );
     }