|
| 1 | +From 0d9e812de5885109532ec8bf484f165213ab97cb Mon Sep 17 00:00:00 2001 |
| 2 | +From: David Mitchell < [email protected]> |
| 3 | +Date: Fri, 14 Dec 2018 16:54:42 +0000 |
| 4 | +Subject: [PATCH] ext/GDBM_File/t/fatal.t: handle non-fatality |
| 5 | + |
| 6 | +This script is supposed to exercise the error handling callback |
| 7 | +mechanism in gdbm, by triggering an error by surreptitiously closing |
| 8 | +the file handle which gdbm has opened. |
| 9 | + |
| 10 | +However, this doesn't trigger an error in newer releases of the gdbm |
| 11 | +library, which uses mmap() rather than write() etc. In fact I can't see |
| 12 | +any way of triggering an error: so just skip the relevant tests if we |
| 13 | +can't trigger a failure. |
| 14 | +--- |
| 15 | + ext/GDBM_File/t/fatal.t | 35 ++++++++++++++++++++++++++--------- |
| 16 | + 1 file changed, 26 insertions(+), 9 deletions(-) |
| 17 | + |
| 18 | +diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t |
| 19 | +index 3ba66be598c..159916901a9 100644 |
| 20 | +--- a/ext/GDBM_File/t/fatal.t |
| 21 | ++++ b/ext/GDBM_File/t/fatal.t |
| 22 | +@@ -1,4 +1,12 @@ |
| 23 | + #!./perl -w |
| 24 | ++# |
| 25 | ++# Exercise the error handling callback mechanism in gdbm. |
| 26 | ++# |
| 27 | ++# Try to trigger an error by surreptitiously closing the file handle which |
| 28 | ++# gdbm has opened. Note that this won't trigger an error in newer |
| 29 | ++# releases of the gdbm library, which uses mmap() rather than write() etc: |
| 30 | ++# so skip in that case. |
| 31 | ++ |
| 32 | + use strict; |
| 33 | + |
| 34 | + use Test::More; |
| 35 | +@@ -34,16 +42,25 @@ isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno") |
| 36 | + or diag("\$! = $!"); |
| 37 | + isnt(close $fh, undef, |
| 38 | + "close fileno $fileno, out from underneath the GDBM_File"); |
| 39 | +-is(eval { |
| 40 | ++ |
| 41 | ++# store some data to a closed file handle |
| 42 | ++ |
| 43 | ++my $res = eval { |
| 44 | + $h{Perl} = 'Rules'; |
| 45 | + untie %h; |
| 46 | +- 1; |
| 47 | +-}, undef, 'Trapped error when attempting to write to knobbled GDBM_File'); |
| 48 | +- |
| 49 | +-# Observed "File write error" and "lseek error" from two different systems. |
| 50 | +-# So there might be more variants. Important part was that we trapped the error |
| 51 | +-# via croak. |
| 52 | +-like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/, |
| 53 | +- 'expected error message from GDBM_File'); |
| 54 | ++ 99; |
| 55 | ++}; |
| 56 | ++ |
| 57 | ++SKIP: { |
| 58 | ++ skip "Can't tigger failure", 2 if $res == 99; |
| 59 | ++ |
| 60 | ++ is $res, undef, "eval should return undef"; |
| 61 | ++ |
| 62 | ++ # Observed "File write error" and "lseek error" from two different |
| 63 | ++ # systems. So there might be more variants. Important part was that |
| 64 | ++ # we trapped the error # via croak. |
| 65 | ++ like($@, qr/ at .*\bfatal\.t line \d+\.\n\z/, |
| 66 | ++ 'expected error message from GDBM_File'); |
| 67 | ++} |
| 68 | + |
| 69 | + unlink <fatal_dbmx*>; |
0 commit comments