do EXPR on dir fails but has no error code $!

[p5pRT]

Migrated from rt.perl.org#125774 (status was 'resolved')

Searchable as RT125774$

[p5pRT]

From @bulk88

Created by @bulk88

The docs for "do EXPR" state

---------------------------------------------------------------------------
If do can read the file but cannot compile it, it returns undef and sets
an error message in $@​ . If do cannot read the file, it returns undef
and sets $! to the error. Always check $@​ first, as compilation could
fail in a way that also sets $! . If the file is successfully compiled,
do returns the value of the last expression evaluated.
---------------------------------------------------------------------------

Lets call do() on a dir.

---------------------------------------------------------------------------
C​:\perl521\srcnewb4opt>perl -MData​::Dumper -E"my $r = do q|C​:\Windows|;
print Du
mper($r, $@​, $!);"
$VAR1 = undef;
$VAR2 = '';
$VAR3 = '';

C​:\perl521\srcnewb4opt>
C​:\perl521\srcnewb4opt>perl -MData​::Dumper -E"my $r = require
q|C​:\Windows|; pri
nt Dumper($r, $@​, $!);"
Can't locate C​:\Windows in @​INC (@​INC contains​:
C​:/perl521/srcnewb4opt/lib .) at
-e line 1.

C​:\perl521\srcnewb4opt>
------------------------------------------------------------------------
~$perl5.22.0 -MData​::Dumper -E'my $r = do q|/bin|; print Dumper($r,$@​,$!);'
$VAR1 = undef;
$VAR2 = '';
$VAR3 = '';
~$
~$perl5.22.0 -MData​::Dumper -E'my $r = require q|/bin|; print
Dumper($r,$@​,$!)>
Can't locate /bin in @​INC (@​INC contains​:
/opt/perl32/lib/site_perl/5.22.0/PA-RISC2.0
/opt/perl32/lib/site_perl/5.22.0 /opt/perl32/lib/5.22.0/PA-RISC2.0
/opt/perl32/lib/5.22.0 .) at -e line 1.
~$
~$perl5.22.0 -MData​::Dumper -E'my $r = do q|/binnofile|; print
Dumper($r,$@​,$!>
$VAR1 = undef;
$VAR2 = '';
$VAR3 = 'No such file or directory';
~$
~$perl5.22.0 -MData​::Dumper -E'my $r = do q|/sbin/passwd|; print
Dumper($r,$@​,>
$VAR1 = undef;
$VAR2 = '';
$VAR3 = 'Permission denied';
~$

------------------------------------------------------------------------

So where is the error in $!?

http​://perl5.git.perl.org/perl.git/blob/HEAD​:/t/op/do.t never tests the
numerical value of $! except against 0.

http​://perl5.git.perl.org/perl.git/commitdiff/b2da7ead6803119763b139be37b2cc8c8f522f75
errno = 0 is questionable API. POSIX never sets errno to 0.

http​://perl5.git.perl.org/perl.git/commitdiff/6b845e562be40aac749b544b6d494078c54de4aa
if it is a dir, errno is effectivly uninitialized

I am proposing that do() on a directory set $!/errno to EISDIR instead of 0.

I found this bug due to me wanting to remove the -f syscall out of
buildcustomize.pl loader code at
http​://perl5.git.perl.org/perl.git/blob/749f0eb1485a7bb7561d71f9539d9b7655363136​:/perl.c#l2106
, the -f was added by
http​://perl5.git.perl.org/perl.git/commitdiff/404ad9dc9dfa2116d2907212d3650df6870ff9bc
but later on commit
http​://perl5.git.perl.org/perl.git/commitdiff/af26e4f23ae11a43d1a3ac56ed110a974e093811
started doing better diagnostics including printing $! on error, since
http​://perl5.git.perl.org/perl.git/commitdiff/404ad9dc9dfa2116d2907212d3650df6870ff9bc
is a commentless commit, IDK why it is doing -f, that leads me to wonder
if its to stop do() on a dir, and I discover do() on a directory returns
no useful error in $! to show the user.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.23.2:

Configured by Owner at Wed Jul 22 12:17:22 2015.

Summary of my perl5 (revision 5 version 23 subversion 2) configuration:
  Derived from: f8ccc6c719cd8ef25c59a4a21fe1bab9f6a38c5b
  Ancestor: 30dc90f1923c08aae65b60f713ac12490a716e10
  Platform:
    osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -GF -W3 -O1 -MD -Zi -DNDEBUG -GL -DWIN32 
-D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT 
-DPERL_IMPLICIT_SYS -D_USE_32BIT_TIME_T',
    optimize='-O1 -MD -Zi -DNDEBUG -GL',
    cppflags='-DWIN32'
    ccversion='13.10.6030', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234, 
doublekind=3
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8, 
longdblkind=0
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', 
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug -opt:ref,icf -ltcg 
        -libpath:"c:\perl521\lib\CORE"         -machine:x86'
    libpth=\lib
    libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib 
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib 
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib 
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib 
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib 
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib 
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl523.lib
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug 
-opt:ref,icf -ltcg         -libpath:"c:\perl521\lib\CORE"        
 -machine:x86'

Locally applied patches:
    uncommitted-changes
    a3b5f9fb00dafcb11d1766baaec76abc90f9fd06
    913cec4246caa89e35bb997c168e7ea2dfcadc4f
    7f279091ed7e7241570d4e4abce94248caeb8869
    ba4fc2b447d5c04e1ada54027c446d03452dcb25
    931a625beed2a34b7d28dca23d41b17e658509d5
    83c1fffeadddac231b705fc8a420de87fd4f5ea3
    41349288283615495b6de1523783d60c9fd7310b
    1c2511e0acc5a19f9f52fb2be58a4e2750213e6f
    ce0b42da7302bf923a6e4080a343f168e4b3b526
    de6cb0abd243e5772b9783a2cbeef5755a8267d6
    262309092c2de925e7ae4a527174f8dc2a0ec7b7
    b92342550433b215a30d5d4b9bfe55321c69f8ac
    9100b351e15341ed12d22822713635b0e4e2237d
    e68670aedff308b76d0c1076a6073146840fb322
    97bf8a2377185e29b65c2d10276fb50d0ad63d41
    fefb073f144151139233ca435fb1fc9edf684fe4
    87518e92cecac2acea7073cceea51ca610774fb0
    ce4793f183b29c423cb9d2d993fb4399c8d46baa
    c4e131a911a886c1978fea41bd198d709effb11e
    dc013420c1f83597b1da234ce2907e675a9e3107
    6962a25d62cfc67866faccd188344d479b518d4a
    0b8e484270e7477903f4a13f1bea68e427a03c70
    3e3bbb9b3cd1149bba698cb5d92fa3150db92d89
    082ce9c667e6d73783164fa1abab61806b678b4f
    638ca15aeec3bf86124489c8c913c5b42d4fee16
    46e58bd2391172ab5e4a73c29fb3313bebcf00bc
    0d610ac116dfe1f7752682b7e30e8019569d8adb
    9b1753cf7072d34b7e4bd1ea60369cbaf80e6152
    fb7e9cdd4113e4cf1a43224b3f50ca540d8fc1b4
    4d5d35d9def298c0adab2e34a187efa998cea923
    db95646430f250935e9615b04eecb9c0d138c515
    139271cd3e9cb3cf25072ebdd400e52275c61b96
    bfab049986675c47a6b5030ff9c8f39c28e7945e
    31221351abb3a508c369e8203d17da077adc667b
    6114e455f60b0de62a0b74edee3c9e1841d49c42
    ad06c68e1547b1a860919feac7df7c509e7efbaf
    d6525a59e9307fd297f8bc4c5e67aae146009637
    1c9e1c249f3ee943b0090563811df613ebae456e
    2ad3e690162d015bf2b0cc83f073d710e8e25fe4
    c3de430b4163fa2425ce1f96c6979354f493ccf4
    e89d87ccef460faf57b78f904d5113b01353308b
    8656412da8e4f5fd0e75563115e66dc105a29bb3
    f282dc56fa0121a54a0752163e66b158b3a60e69
    c1883b8b014bf0c1dad3d50b6052ef68120c7247
    904c4cac2b93435ab1ae1b204e376b99fc770895
    c56f8d90b66d2ad5aab73a192124dbef90a32af0
    cf73cedaf40b99f39f3b4c5d0fa1aa0f125c73e3
    430812d753cb6126658aa5764d72c857935e7552
    923c264ef19ba3c5a3351e7ae6c73b8bde122801
    a619091c6e82aa7538af9defae3262a68921e66d
    04edae75060b165358c49e90531901bb186e160e
    cc116ce7f30f9861a5b501456e5dfaf8e57de587
    e7f1d4a74b38eea00e7928f048d1981610a4bced
    14071f951e2facb2599e25258093b7c4426a2b4a
    003900e275f0c45375d4d02ffb0ac0fcd2eacfa2
    c7a622b32220ef59969124212598b6848bcaa247
    86f4502880c5cbc7a5ec1510ab05a413bfb40e03
    23fd77c01aafa1987698dc47bed34bd342178516
    16bc0f484029674886960a735bef3fa497aeb6de
    4ad176efffec2453196c8a3f35f73c0eeed776a0
    5478a2b983aa7a04b93cfaf83bb9805713bf2d3f
    6ffcffbd7dc3d42844ba051086599e4f70bfdb1f
    bbef9e8971749a5008bb4cd805eff6a7e0c584b4
    b992490dd5c64d667e649dd0ee35a658034d93c0
    f7e03a1013a0b759f99885c500f0e89656a992ba
    a55c5245146801ac2b2be2914342a6a829670513
    f832b29a2b3f71c66c6e6b76a02b5faefe0ebeb1
    e27be216b1132c5c017dc516d806edf309c90386
    8a62d6b8193214bd476c275fc4b083b526108223
    48e9f29d31f13e3ebfb9f77ed4effa561966c7a9
    42d29f360f39f2ec518ddc4b80f4284099e75689
    94dbd6cfe2263c2f66825f35679153e430e506e5
    37b95795022b11ae328e98d5e247a2a8ca8593ca
    b36000125e2dbb5bf2e2e2580b5fa7572e13a768
    f8ccc6c719cd8ef25c59a4a21fe1bab9f6a38c5b


@INC for perl 5.23.2:
    C:/perl521/site/lib
    C:/perl521/lib
    .


Environment for perl 5.23.2:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=C:\perl521\bin;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\IDE;C:\Program Files\Microsoft Visual Studio .NET 
2003\VC7\BIN;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\Tools;C:\Program Files\Microsoft Visual Studio .NET 
2003\Common7\Tools\bin\prerelease;C:\WINDOWS\system32;C:\WINDOWS;C:\WINDOWS\system32\wbem;
    PERL_BADLANG (unset)
    SHELL (unset)

[p5pRT]

From gdg@zplane.com

bulk88 <perlbug-followup@​perl.org> [2015-08-09 13​:42​:44 -0700]​:

# New Ticket Created by bulk88
# Please include the string​: [perl #125774]
# in the subject line of all future correspondence about this issue.
# <URL​: https://rt-archive.perl.org/perl5/Ticket/Display.html?id=125774 >

This is a bug report for perl from bulk88@​hotmail.com,
generated with the help of perlbug 1.40 running under perl 5.23.2.

-----------------------------------------------------------------
[Please describe your issue here]

The docs for "do EXPR" state

---------------------------------------------------------------------------
If do can read the file but cannot compile it, it returns undef and sets
an error message in $@​ . If do cannot read the file, it returns undef
and sets $! to the error. Always check $@​ first, as compilation could
fail in a way that also sets $! . If the file is successfully compiled,
do returns the value of the last expression evaluated.
---------------------------------------------------------------------------

[ ... ]

Would it make sense to somehow combine/consolidate the above perlbug with
this thread

  http​://www.nntp.perl.org/group/perl.perl5.porters/2015/05/msg227897.html

which is an ongoing debate on the state of the "do EXPR" doc in general?

I have no technical skin the game advocating any position, just trying to be
a good "thread steward", since the above thread was started by me.

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @ikegami

On Sun, Aug 9, 2015 at 7​:04 PM, Glenn Golden <gdg@​zplane.com> wrote​:

Would it make sense to somehow combine/consolidate the above perlbug with
this thread

bulk88 is reporting a failure of do() to report an error. This is
independent of the wording of the docs.

[p5pRT]

From @ap

* Eric Brine <ikegami@​adaelis.com> [2015-08-10 05​:50]​:

bulk88 is reporting a failure of do() to report an error. This is
independent of the wording of the docs.

The reason the wording of the docs is in contention is that `do` has
an error reporting interface so crappy that we cannot even agree on how
to detect errors with it. Bulk88’s issue is just another aspect of that.
Nevertheless these tickets are distinct aspects of the same thing; their
kinship is of the “we need a metaticket about how to unhorriblify `do`
in general” kind.

I had a conversation about it with RJBS that I meant to summarize and
post; I’ll get to that eventually.

Regards,
--
Aristotle Pagaltzis // <http​://plasmasturm.org/>

[p5pRT]

From @bulk88

Since there were no comments on what the error code should be, I wrote a patch that fixes this bug. See attached.

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @bulk88

0001-perl-125774-fix-do-dir-returns-no.patch

From bc453c910fc935db8524e9d6ea19130407c19e9f Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 16 Aug 2015 04:30:23 -0400
Subject: [PATCH] [perl #125774] fix do dir returns no $!

do()ing a directory was returning false/empty string in $!, which isn't an
error, yet retval of do, and $@ say $! should have the error code in it.
Fix this by returning EISDIR for dirs, and EINVAL for block devices, since
there is no ENOTFILE, but ENOENT is inappropriate, since the block device
exists. Also linux read() returns EINVAL if the underlying kernel driver
does not implement a read method. Here we say read() (on a high level do())
is not implemented on a directory. Also linux swapon() uses EINVAL for
paths which goto something that exists, but is of wrong type.

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, previously they didnt.
---
 pod/perldelta.pod |    6 ++++++
 pp_ctl.c          |   25 +++++++++++++++++--------
 t/op/do.t         |   14 +++++++++++++-
 3 files changed, 36 insertions(+), 9 deletions(-)

diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 157d9d1..2ec1f08 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -356,6 +356,12 @@ Perl can again be compiled with any Unicode version.  This used to
 C<Name_Alias> did not exist prior to Unicode 5.0.  L<Unicode::UCD>
 incorrectly said it did.  This has been fixed.
 
+=item *
+
+Calling C<do $path> on a directory or block device returned no error code in
+C<$!> even though the retval of C<do> and C<$@> indicated the error is in C<$!>.
+[perl #125774]
+
 =back
 
 =head1 Known Problems
diff --git a/pp_ctl.c b/pp_ctl.c
index 9a81583..d80ed77 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3505,15 +3505,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
 
@@ -3525,8 +3532,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 49c0de3..7eb923d 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"
@@ -280,4 +281,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();
-- 
1.7.9.msysgit.0

[p5pRT]

From @bulk88

On Sun Aug 16 03​:48​:41 2015, bulk88 wrote​:

Since there were no comments on what the error code should be, I wrote
a patch that fixes this bug. See attached.

Bump.

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

From @rjbs

On Mon Aug 10 09​:12​:05 2015, aristotle wrote​:

I had a conversation about it with RJBS that I meant to summarize and
post; I’ll get to that eventually.

Have you gotten around to that? I don't see it in my folder, so if so​: link?

--
rjbs

[p5pRT]

From @rjbs

On Wed Sep 09 06​:50​:40 2015, bulk88 wrote​:

On Sun Aug 16 03​:48​:41 2015, bulk88 wrote​:

Since there were no comments on what the error code should be, I wrote
a patch that fixes this bug. See attached.

Bump.

Is there some reason not to apply this? My reading suggests it's a solution to a demonstrable problem.

--
rjbs

[p5pRT]

From zefram@fysh.org

Patch applied as commit d1ac83c.

-zefram

[p5pRT]

@cpansprout - Status changed from 'open' to 'pending release'

[p5pRT]

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release yesterday of Perl 5.28.0, this and 185 other issues have been
resolved.

Perl 5.28.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.28.0

If you find that the problem persists, feel free to reopen this ticket.

[p5pRT]

@khwilliamson - Status changed from 'pending release' to 'resolved'