From: Yves Orton <demerphq@gmail.com>
Date: Thu, 25 May 2006 13:20:53 +0000 (+0200)
Subject: Re: [PATCH] Test script for DynaLoader
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c3026122df2ea8c3b01e4d1278d0519e50eeab9a;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH] Test script for DynaLoader
Message-ID: <9b18b3110605250420m7431bfbeve44aada2025264f7@mail.gmail.com>

p4raw-id: //depot/perl@28308
---

diff --git a/ext/DynaLoader/t/DynaLoader.t b/ext/DynaLoader/t/DynaLoader.t
index 841fa22..23af852 100644
--- a/ext/DynaLoader/t/DynaLoader.t
+++ b/ext/DynaLoader/t/DynaLoader.t
@@ -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" );
     }