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