Import perl-5.30.1

Timing is good deraadt@, OK sthen@

1 files changed, 28 insertions, 11 deletions

diff --git a/gnu/usr.bin/perl/ext/GDBM_File/t/fatal.t b/gnu/usr.bin/perl/ext/GDBM_File/t/fatal.t
index 0e426d4dbcd..1cbfdc60181 100644
--- a/gnu/usr.bin/perl/ext/GDBM_File/t/fatal.t
+++ b/gnu/usr.bin/perl/ext/GDBM_File/t/fatal.t
@@ -1,4 +1,12 @@
 #!./perl -w
+#
+# Exercise the error handling callback mechanism in gdbm.
+#
+# Try to trigger an error by surreptitiously closing the file handle which
+# gdbm has opened.  Note that this won't trigger an error in newer
+# releases of the gdbm library, which uses mmap() rather than write() etc:
+# so skip in that case.
+
 use strict;
 
 use Test::More;
@@ -16,7 +24,7 @@ BEGIN {
     use_ok('GDBM_File');
 }
 
-unlink <Op_dbmx*>;
+unlink <fatal_dbmx*>;
 
 open my $fh, '<', $^X or die "Can't open $^X: $!";
 my $fileno = fileno $fh;
@@ -28,22 +36,31 @@ is((open $fh, "<&=$fileno"), undef,
 
 umask(0);
 my %h;
-isa_ok(tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File');
+isa_ok(tie(%h, 'GDBM_File', 'fatal_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File');
 
 isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno")
     or diag("\$! = $!");
 isnt(close $fh, undef,
      "close fileno $fileno, out from underneath the GDBM_File");
-is(eval {
+
+# store some data to a closed file handle
+
+my $res = eval {
     $h{Perl} = 'Rules';
     untie %h;
-    1;
-}, undef, 'Trapped error when attempting to write to knobbled GDBM_File');
+    99;
+};
 
-# Observed "File write error" and "lseek error" from two different systems.
-# So there might be more variants. Important part was that we trapped the error
-# via croak.
-like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
-     'expected error message from GDBM_File');
+SKIP: {
+    skip "Can't trigger failure", 2 if (defined $res and $res == 99);
+
+    is $res, undef, "eval should return undef";
+
+    # Observed "File write error" and "lseek error" from two different
+    # systems.  So there might be more variants. Important part was that
+    # we trapped the error # via croak.
+    like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/,
+         'expected error message from GDBM_File');
+}
 
-unlink <Op_dbmx*>;
+unlink <fatal_dbmx*>;