Blame SOURCES/perl-5.16.1-RT-113730-should-be-cleared-on-do-IO-error.patch
|
 |
292b33 |
From a3ff80c12c16886edf9acdd3d172798e50defdb3 Mon Sep 17 00:00:00 2001
|
|
|
292b33 |
From: Eric Brine <ikegami@adaelis.com>
|
|
|
292b33 |
Date: Mon, 18 Jun 2012 14:56:32 -0400
|
|
|
292b33 |
Subject: [PATCH] RT#113730 - $@ should be cleared on "do" IO error.
|
|
|
292b33 |
|
|
|
292b33 |
---
|
|
|
292b33 |
pp_ctl.c | 1 +
|
|
|
292b33 |
t/op/do.t | 12 ++++++++++++
|
|
|
292b33 |
2 files changed, 13 insertions(+)
|
|
|
292b33 |
|
|
|
292b33 |
diff --git a/pp_ctl.c b/pp_ctl.c
|
|
|
292b33 |
index b414e81..437bc8f 100644
|
|
|
292b33 |
--- a/pp_ctl.c
|
|
|
292b33 |
+++ b/pp_ctl.c
|
|
|
292b33 |
@@ -3928,6 +3928,7 @@ PP(pp_require)
|
|
|
292b33 |
DIE(aTHX_ "Can't locate %s", name);
|
|
|
292b33 |
}
|
|
|
292b33 |
|
|
|
292b33 |
+ CLEAR_ERRSV();
|
|
|
292b33 |
RETPUSHUNDEF;
|
|
|
292b33 |
}
|
|
|
292b33 |
else
|
|
|
292b33 |
diff --git a/t/op/do.t b/t/op/do.t
|
|
|
292b33 |
index 93d3f73..c5a5905 100644
|
|
|
292b33 |
--- a/t/op/do.t
|
|
|
292b33 |
+++ b/t/op/do.t
|
|
|
292b33 |
@@ -286,4 +286,16 @@ SKIP: {
|
|
|
292b33 |
is($w, undef, 'do STRING does not propagate warning hints');
|
|
|
292b33 |
}
|
|
|
292b33 |
|
|
|
292b33 |
+# RT#113730 - $@ should be cleared on IO error.
|
|
|
292b33 |
+{
|
|
|
292b33 |
+ $@ = "should not see";
|
|
|
292b33 |
+ $! = 0;
|
|
|
292b33 |
+ my $rv = do("some nonexistent file");
|
|
|
292b33 |
+ my $saved_error = $@;
|
|
|
292b33 |
+ my $saved_errno = $!;
|
|
|
292b33 |
+ ok(!$rv, "do returns false on io errror");
|
|
|
292b33 |
+ ok(!$saved_error, "\$\@ not set on io error");
|
|
|
292b33 |
+ ok($saved_errno, "\$! set on io error");
|
|
|
292b33 |
+}
|
|
|
292b33 |
+
|
|
|
292b33 |
done_testing();
|
|
|
292b33 |
--
|
|
|
292b33 |
1.7.11.4
|
|
|
292b33 |
|