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