1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
From c1b4fc4a319f8139d1cd6770bfb7b72a59ae232d Mon Sep 17 00:00:00 2001
From: Niko Tyni <ntyni@debian.org>
Date: Mon, 21 Dec 2015 19:20:12 +0200
Subject: [PATCH] Fix a scoping issue with "no autodie" and the "system" sub
Don't queue nonexisting subs for reinstalling later when
exiting the 'no autodie' scope.
FIXME: if the original sub 'can be undef for "CORE::" subs', does this
break for those? Is that the case when $symbol =~ /::/, as guarded for
on L566?
Bug: https://github.com/pjf/autodie/issues/69
Bug-Debian: https://bugs.debian.org/798096
Origin: upstream, https://github.com/pjf/autodie/commit/c1b4fc4a319f8139d1cd6770bfb7b72a59ae232d
---
lib/Fatal.pm | 7 ++++++-
t/no-all.t | 22 ++++++++++++++++++++++
t/no-default.t | 23 +++++++++++++++++++++++
3 files changed, 51 insertions(+), 1 deletion(-)
create mode 100755 t/no-all.t
create mode 100755 t/no-default.t
diff --git a/lib/Fatal.pm b/lib/Fatal.pm
index 62ec1c0..d0f9cef 100644
--- a/lib/Fatal.pm
+++ b/lib/Fatal.pm
@@ -581,7 +581,12 @@ sub unimport {
# Record the current sub to be reinstalled at end of scope
# and then restore the original (can be undef for "CORE::"
# subs)
- $reinstall_subs{$symbol} = \&$sub;
+
+ {
+ no strict 'refs';
+ $reinstall_subs{$symbol} = \&$sub
+ if exists ${"${pkg}::"}{$symbol};
+ }
$uninstall_subs{$symbol} = $Original_user_sub{$sub};
}
diff --git a/t/no-all.t b/t/no-all.t
new file mode 100755
index 0000000..1a503f6
--- /dev/null
+++ b/t/no-all.t
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+package foo;
+use warnings;
+use strict;
+use Test::More tests => 1;
+use autodie qw(:all);
+
+use_system();
+ok("system() works with a lexical 'no autodie' block (github issue #69");
+
+sub break_system {
+ no autodie;
+ open(my $fh, "<", 'NONEXISTENT');
+ ok("survived failing open");
+}
+
+sub use_system {
+ system($^X, '-e' , 1);
+}
+
+1;
diff --git a/t/no-default.t b/t/no-default.t
new file mode 100755
index 0000000..44d2acf
--- /dev/null
+++ b/t/no-default.t
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+
+package foo;
+use warnings;
+use strict;
+use Test::More tests => 2;
+use autodie;
+
+
+use_system();
+ok("system() works with a lexical 'no autodie' block (github issue #69");
+break_system();
+
+sub break_system {
+ no autodie;
+ open(my $fh, "<", 'NONEXISTENT');
+ ok("survived failing open");
+}
+
+sub use_system {
+ system($^X, '-e' , 1);
+}
+1;
--
2.6.4
|
