Sophie

Sophie

distrib > Fedora > 16 > i386 > by-pkgid > d98c537a3bfb1ca3fd7f834a983812e7 > files > 7

perl-5.14.3-205.fc16.src.rpm

From c972fa9ce0ad91f72c8f5650ce1e3aae4a3b571a Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Mon, 18 Jun 2012 14:56:32 -0400
Subject: [PATCH] RT#113730 - $@ should be cleared on "do" IO error.

Petr Pisar: Ported to 5.14.2:

From a3ff80c12c16886edf9acdd3d172798e50defdb3 Mon Sep 17 00:00:00 2001
From: Eric Brine <ikegami@adaelis.com>
Date: Mon, 18 Jun 2012 14:56:32 -0400
Subject: [PATCH] RT#113730 - $@ should be cleared on "do" IO error.
---
 pp_ctl.c  |  1 +
 t/op/do.t | 12 ++++++++++++
 2 files changed, 13 insertions(+)

diff --git a/pp_ctl.c b/pp_ctl.c
index 60bc30d..3f2e6f5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3842,6 +3842,7 @@ PP(pp_require)
 	    DIE(aTHX_ "Can't locate %s", name);
 	}
 
+	CLEAR_ERRSV();
 	RETPUSHUNDEF;
     }
     else
diff --git a/t/op/do.t b/t/op/do.t
index 787d632..4c9f0ef 100644
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -197,4 +197,16 @@ is($x, 4, 'if (0){} else { ...; @a } receives caller scalar context');
 @x = sub { if (0){} else { 0; @a } }->();
 is("@x", "24 25 26 27", 'if (0){} else { ...; @a } receives caller list context');
 
+# RT#113730 - $@ should be cleared on IO error.
+{
+    $@ = "should not see";
+    $! = 0;
+    my $rv = do("some nonexistent file");
+    my $saved_error = $@;
+    my $saved_errno = $!;
+    ok(!$rv,          "do returns false on io errror");
+    ok(!$saved_error, "\$\@ not set on io error");
+    ok($saved_errno,  "\$! set on io error");
+}
+
 done_testing();
-- 
1.7.11.4