In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/d1ac83c4011b4bf51ca3fb070737a97a6c6ac545?hp=69374fe705978962b85217f3eb828a93f836fd8d>
- Log -----------------------------------------------------------------
commit d1ac83c4011b4bf51ca3fb070737a97a6c6ac545
Author: Daniel Dragan <bul...@hotmail.com>
Date: Sun Aug 16 04:30:23 2015 -0400
fix do dir returning no $!
do()ing a directory was returning false/empty string in $!, which isn't
an error, yet documentation says $! should have the error code in it.
Fix this by returning EISDIR for dirs, and EINVAL for block devices.
[perl #125774]
Remove "errno = 0" and comment added in b2da7ead68, since now there is no
scenario where errno is uninitialized, since the dir and block device
failure branches now set errno, where previously they didn't.
-----------------------------------------------------------------------
Summary of changes:
pod/perldelta.pod | 5 +++++
pp_ctl.c | 25 +++++++++++++++++--------
t/op/do.t | 14 +++++++++++++-
3 files changed, 35 insertions(+), 9 deletions(-)
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 51953078c3..f292b52fe7 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -558,6 +558,11 @@ operator. [perl #132245]
Fixed a leaked SV when parsing an empty C<\N{}> at compile-time.
[perl #132245]
+=item *
+
+Calling C<do $path> on a directory or block device now yields a meaningful
+error code in C<$!>. [perl #125774]
+
=back
=head1 Known Problems
diff --git a/pp_ctl.c b/pp_ctl.c
index a113b48db8..7581b37985 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3562,15 +3562,22 @@ S_check_type_and_open(pTHX_ SV *name)
errno EACCES, so only do a stat to separate a dir from a real EACCES
caused by user perms */
#ifndef WIN32
- /* we use the value of errno later to see how stat() or open() failed.
- * We don't want it set if the stat succeeded but we still failed,
- * such as if the name exists, but is a directory */
- errno = 0;
-
st_rc = PerlLIO_stat(p, &st);
- if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+ if (st_rc < 0)
return NULL;
+ else {
+ int eno;
+ if(S_ISBLK(st.st_mode)) {
+ eno = EINVAL;
+ goto not_file;
+ }
+ else if(S_ISDIR(st.st_mode)) {
+ eno = EISDIR;
+ not_file:
+ errno = eno;
+ return NULL;
+ }
}
#endif
@@ -3582,8 +3589,10 @@ S_check_type_and_open(pTHX_ SV *name)
int eno;
st_rc = PerlLIO_stat(p, &st);
if (st_rc >= 0) {
- if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode))
- eno = 0;
+ if(S_ISDIR(st.st_mode))
+ eno = EISDIR;
+ else if(S_ISBLK(st.st_mode))
+ eno = EINVAL;
else
eno = EACCES;
errno = eno;
diff --git a/t/op/do.t b/t/op/do.t
index 78d8800886..1c54f0b410 100644
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -7,6 +7,7 @@ BEGIN {
}
use strict;
no warnings 'void';
+use Errno qw(ENOENT EISDIR);
my $called;
my $result = do{ ++$called; 'value';};
@@ -247,7 +248,7 @@ SKIP: {
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");
+ ok($saved_errno == ENOENT, "\$! is ENOENT for nonexistent file");
}
# do subname should not be do "subname"
@@ -305,4 +306,15 @@ SKIP: {
}
+# do file $!s must be correct
+{
+ local @INC = ('.'); #want EISDIR not ENOENT
+ my $rv = do 'op'; # /t/op dir
+ my $saved_error = $@;
+ my $saved_errno = $!+0;
+ ok(!$rv, "do dir returns false");
+ ok(!$saved_error, "\$\@ is false on do dir");
+ ok($saved_errno == EISDIR, "\$! is EISDIR on do dir");
+}
+
done_testing();
--
Perl5 Master Repository
