In perl.git, the branch smoke-me/tonyc/127760-file-path-debug has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/62828866405cf0f1b7a311e9f48115935b2bdd68?hp=84b159bbc1b51de572bcccbd21d13d21956fccca> - Log ----------------------------------------------------------------- commit 62828866405cf0f1b7a311e9f48115935b2bdd68 Author: Tony Cook <t...@develop-help.com> Date: Wed Mar 23 12:08:56 2016 +1100 add more debug code ----------------------------------------------------------------------- Summary of changes: pp_sys.c | 8 +++++++- win32/win32.c | 16 ++++++++++++++-- 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 33cba46..fa7ea6b 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -2873,6 +2873,7 @@ PP(pp_stat) U8 gimme; I32 max = 13; SV* sv; + BOOL debug_stat = PerlEnv_getenv("DEBUG_STAT") != NULL; if (PL_op->op_flags & OPf_REF ? (gv = cGVOP_gv, 1) : !!(sv=POPs, gv = MAYBE_DEREF_GV(sv))) { @@ -2934,12 +2935,17 @@ PP(pp_stat) goto do_fstat_warning_check; goto do_fstat_have_io; } - + SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ sv_setpv(PL_statname, SvPV_nomg_const_nolen(sv)); PL_statgv = NULL; PL_laststype = PL_op->op_type; file = SvPV_nolen_const(PL_statname); + if (debug_stat) { +#define QQX_(x) #x +#define QQX(x) QQX_(x) + PerlIO_printf(PerlIO_stderr(), "calling stat '%s'\n", PL_op->op_type == OP_LSTAT ? QQX(PerlLIO_lstat(file, &PL_statcache)) : QQX(PerlLIO_stat(file, &PL_statcache))); + } if (PL_op->op_type == OP_LSTAT) PL_laststatval = PerlLIO_lstat(file, &PL_statcache); else diff --git a/win32/win32.c b/win32/win32.c index 66686e3..cce9c50 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1462,7 +1462,7 @@ win32_stat(const char *path, Stat_t *sbuf) int res; int nlink = 1; BOOL expect_dir = FALSE; - BOOL debug_stat = PerlEnv_getenv("DEBUG_STAT") != NULL; + BOOL debug_stat = win32_getenv("DEBUG_STAT") != NULL; if (debug_stat) { PerlIO_printf(PerlIO_stderr(), "win32_stat(%s)\n", path); @@ -1561,10 +1561,13 @@ win32_stat(const char *path, Stat_t *sbuf) if (!(r & FILE_ATTRIBUTE_READONLY)) sbuf->st_mode |= S_IWRITE | S_IEXEC; if (debug_stat) { - PerlIO_printf(PerlIO_stderr(), "stat() - but success as share name\n", res); + PerlIO_printf(PerlIO_stderr(), "stat() - but success as share name\n"); } return 0; } + if (debug_stat) { + PerlIO_printf(PerlIO_stderr(), "stat() - fail as share name\n"); + } } else { if (l == 3 && isALPHA(path[0]) && path[1] == ':' @@ -1572,11 +1575,17 @@ win32_stat(const char *path, Stat_t *sbuf) { /* The drive can be inaccessible, some _stat()s are buggy */ if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { + if (debug_stat) { + PerlIO_printf(PerlIO_stderr(), "stat() - fail as bad drive letter\n"); + } errno = ENOENT; return -1; } } if (expect_dir && !S_ISDIR(sbuf->st_mode)) { + if (debug_stat) { + PerlIO_printf(PerlIO_stderr(), "stat() - fail as expect_dir\n"); + } errno = ENOTDIR; return -1; } @@ -1593,6 +1602,9 @@ win32_stat(const char *path, Stat_t *sbuf) } } } + if (debug_stat) { + PerlIO_printf(PerlIO_stderr(), "stat() - final %d\n", res); + } return res; } -- Perl5 Master Repository
