34484a
From 3dfcac940930a8aa6779f5debea6ea6357372419 Mon Sep 17 00:00:00 2001
34484a
From: Daniel Dragan <bulk88@hotmail.com>
34484a
Date: Sun, 16 Aug 2015 04:30:23 -0400
34484a
Subject: [PATCH] fix do dir returning no $!
34484a
MIME-Version: 1.0
34484a
Content-Type: text/plain; charset=UTF-8
34484a
Content-Transfer-Encoding: 8bit
34484a
34484a
do()ing a directory was returning false/empty string in $!, which isn't
34484a
an error, yet documentation says $! should have the error code in it.
34484a
Fix this by returning EISDIR for dirs, and EINVAL for block devices.
34484a
[perl #125774]
34484a
34484a
Remove "errno = 0" and comment added in b2da7ead68, since now there is no
34484a
scenario where errno is uninitialized, since the dir and block device
34484a
failure branches now set errno, where previously they didn't.
34484a
34484a
Petr Písař: Ported to 5.26.1.
34484a
34484a
Signed-off-by: Petr Písař <ppisar@redhat.com>
34484a
---
34484a
 pp_ctl.c  | 25 +++++++++++++++++--------
34484a
 t/op/do.t | 14 +++++++++++++-
34484a
 2 files changed, 30 insertions(+), 9 deletions(-)
34484a
34484a
diff --git a/pp_ctl.c b/pp_ctl.c
34484a
index e24d7b6..f136f91 100644
34484a
--- a/pp_ctl.c
34484a
+++ b/pp_ctl.c
34484a
@@ -3534,15 +3534,22 @@ S_check_type_and_open(pTHX_ SV *name)
34484a
        errno EACCES, so only do a stat to separate a dir from a real EACCES
34484a
        caused by user perms */
34484a
 #ifndef WIN32
34484a
-    /* we use the value of errno later to see how stat() or open() failed.
34484a
-     * We don't want it set if the stat succeeded but we still failed,
34484a
-     * such as if the name exists, but is a directory */
34484a
-    errno = 0;
34484a
-
34484a
     st_rc = PerlLIO_stat(p, &st);
34484a
 
34484a
-    if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
34484a
+    if (st_rc < 0)
34484a
 	return NULL;
34484a
+    else {
34484a
+	int eno;
34484a
+	if(S_ISBLK(st.st_mode)) {
34484a
+	    eno = EINVAL;
34484a
+	    goto not_file;
34484a
+	}
34484a
+	else if(S_ISDIR(st.st_mode)) {
34484a
+	    eno = EISDIR;
34484a
+	    not_file:
34484a
+	    errno = eno;
34484a
+	    return NULL;
34484a
+	}
34484a
     }
34484a
 #endif
34484a
 
34484a
@@ -3554,8 +3561,10 @@ S_check_type_and_open(pTHX_ SV *name)
34484a
 	int eno;
34484a
 	st_rc = PerlLIO_stat(p, &st);
34484a
 	if (st_rc >= 0) {
34484a
-	    if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode))
34484a
-		eno = 0;
34484a
+	    if(S_ISDIR(st.st_mode))
34484a
+		eno = EISDIR;
34484a
+	    else if(S_ISBLK(st.st_mode))
34484a
+		eno = EINVAL;
34484a
 	    else
34484a
 		eno = EACCES;
34484a
 	    errno = eno;
34484a
diff --git a/t/op/do.t b/t/op/do.t
34484a
index 78d8800..1c54f0b 100644
34484a
--- a/t/op/do.t
34484a
+++ b/t/op/do.t
34484a
@@ -7,6 +7,7 @@ BEGIN {
34484a
 }
34484a
 use strict;
34484a
 no warnings 'void';
34484a
+use Errno qw(ENOENT EISDIR);
34484a
 
34484a
 my $called;
34484a
 my $result = do{ ++$called; 'value';};
34484a
@@ -247,7 +248,7 @@ SKIP: {
34484a
     my $saved_errno = $!;
34484a
     ok(!$rv,          "do returns false on io errror");
34484a
     ok(!$saved_error, "\$\@ not set on io error");
34484a
-    ok($saved_errno,  "\$! set on io error");
34484a
+    ok($saved_errno == ENOENT, "\$! is ENOENT for nonexistent file");
34484a
 }
34484a
 
34484a
 # do subname should not be do "subname"
34484a
@@ -305,4 +306,15 @@ SKIP: {
34484a
 }
34484a
 
34484a
 
34484a
+# do file $!s must be correct
34484a
+{
34484a
+    local @INC = ('.'); #want EISDIR not ENOENT
34484a
+    my $rv = do 'op'; # /t/op dir
34484a
+    my $saved_error = $@;
34484a
+    my $saved_errno = $!+0;
34484a
+    ok(!$rv,                    "do dir returns false");
34484a
+    ok(!$saved_error,           "\$\@ is false on do dir");
34484a
+    ok($saved_errno == EISDIR,  "\$! is EISDIR on do dir");
34484a
+}
34484a
+
34484a
 done_testing();
34484a
-- 
34484a
2.13.6
34484a