81 lines
2.6 KiB
Diff
81 lines
2.6 KiB
Diff
|
From 72cc38bc65d4a675d9134acb085d2e0c3dcd5383 Mon Sep 17 00:00:00 2001
|
||
|
|
From: David Mitchell <davem@iabyn.com>
|
||
|
|
Date: Fri, 14 Dec 2018 16:54:42 +0000
|
||
|
|
Subject: [PATCH] ext/GDBM_File/t/fatal.t: handle non-fatality
|
||
|
|
MIME-Version: 1.0
|
||
|
|
Content-Type: text/plain; charset=UTF-8
|
||
|
|
Content-Transfer-Encoding: 8bit
|
||
|
|
|
||
|
|
This script is supposed to exercise the error handling callback
|
||
|
|
mechanism in gdbm, by triggering an error by surreptitiously closing
|
||
|
|
the file handle which gdbm has opened.
|
||
|
|
|
||
|
|
However, this doesn't trigger an error in newer releases of the gdbm
|
||
|
|
library, which uses mmap() rather than write() etc. In fact I can't see
|
||
|
|
any way of triggering an error: so just skip the relevant tests if we
|
||
|
|
can't trigger a failure.
|
||
|
|
|
||
|
|
Petr Písař: Ported to 5.28.1 from
|
||
|
|
upstream's d33f9fbdb3bb27a3b32a2ffa9aa035617c07f7a1.
|
||
|
|
|
||
|
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||
|
|
---
|
||
|
|
ext/GDBM_File/t/fatal.t | 35 ++++++++++++++++++++++++++---------
|
||
|
|
1 file changed, 26 insertions(+), 9 deletions(-)
|
||
|
|
|
||
|
|
diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t
|
||
|
|
index 0e426d4..6945653 100644
|
||
|
|
--- a/ext/GDBM_File/t/fatal.t
|
||
|
|
+++ b/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;
|
||
|
|
@@ -34,16 +42,25 @@ 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');
|
||
|
|
-
|
||
|
|
-# 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');
|
||
|
|
+ 99;
|
||
|
|
+};
|
||
|
|
+
|
||
|
|
+SKIP: {
|
||
|
|
+ skip "Can't tigger failure", 2 if $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*>;
|
||
|
|
--
|
||
|
|
2.17.2
|
||
|
|
|