Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \
|NN CLONE_PARAMS* param
Ap |PerlIO*|fp_dup |NULLOK PerlIO *const fp|const char type|NN CLONE_PARAMS *const param
-ApR |DIR* |dirp_dup |NULLOK DIR *const dp
+ApR |DIR* |dirp_dup |NULLOK DIR *const dp|NN CLONE_PARAMS *const param
ApR |GP* |gp_dup |NULLOK GP *const gp|NN CLONE_PARAMS *const param
ApR |MAGIC* |mg_dup |NULLOK MAGIC *mg|NN CLONE_PARAMS *const param
#if defined(PERL_IN_SV_C)
#if defined(USE_ITHREADS)
#define any_dup(a,b) Perl_any_dup(aTHX_ a,b)
#define cx_dup(a,b,c,d) Perl_cx_dup(aTHX_ a,b,c,d)
-#define dirp_dup(a) Perl_dirp_dup(aTHX_ a)
+#define dirp_dup(a,b) Perl_dirp_dup(aTHX_ a,b)
#define fp_dup(a,b,c) Perl_fp_dup(aTHX_ a,b,c)
#define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b)
#define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c)
#define PERL_ARGS_ASSERT_CX_DUP \
assert(param)
-PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR *const dp)
- __attribute__warn_unused_result__;
+PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_DIRP_DUP \
+ assert(param)
PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO *const fp, const char type, CLONE_PARAMS *const param)
__attribute__nonnull__(pTHX_3);
/* duplicate a directory handle */
DIR *
-Perl_dirp_dup(pTHX_ DIR *const dp)
+Perl_dirp_dup(pTHX_ DIR *const dp, CLONE_PARAMS *const param)
{
-#ifdef HAS_FCHDIR
DIR *ret;
+
+#ifdef HAS_FCHDIR
DIR *pwd;
register const Direntry_t *dirent;
char smallbuf[256];
#endif
PERL_UNUSED_CONTEXT;
+ PERL_ARGS_ASSERT_DIRP_DUP;
-#ifdef HAS_FCHDIR
if (!dp)
return (DIR*)NULL;
+
/* look for it in the table first */
ret = (DIR*)ptr_table_fetch(PL_ptr_table, dp);
if (ret)
return ret;
+#ifdef HAS_FCHDIR
+
+ PERL_UNUSED_ARG(param);
+
/* create anew */
/* open the current directory (so we can switch back) */
if (name && name != smallbuf)
Safefree(name);
+#endif
+
+#ifdef WIN32
+ ret = win32_dirp_dup(dp, param);
+#endif
/* pop it in the pointer table */
- ptr_table_store(PL_ptr_table, dp, ret);
+ if (ret)
+ ptr_table_store(PL_ptr_table, dp, ret);
return ret;
-#else
- return (DIR*)NULL;
-#endif
}
/* duplicate a typeglob */
IoFMT_GV(dstr) = gv_dup(IoFMT_GV(dstr), param);
IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(dstr), param);
if (IoDIRP(dstr)) {
- IoDIRP(dstr) = dirp_dup(IoDIRP(dstr));
+ IoDIRP(dstr) = dirp_dup(IoDIRP(dstr), param);
} else {
NOOP;
/* IoDIRP(dstr) is already a copy of IoDIRP(sstr) */
skip $_[0], 5
};
- if(!$Config::Config{d_fchdir}) {
- $::TODO = 'dir handle cloning currently requires fchdir';
+ if(!$Config::Config{d_fchdir} && $^O ne "MSWin32") {
+ $::TODO = 'dir handle cloning currently requires fchdir on non-Windows platforms';
}
my @w :shared; # warnings accumulator
char buffer[MAX_PATH*2];
char *ptr;
+ if (dirp->handle == INVALID_HANDLE_VALUE) {
+ res = 0;
+ }
/* finding the next file that matches the wildcard
* (which should be all of them in this directory!).
*/
- if (IsWin2000()) {
+ else if (IsWin2000()) {
WIN32_FIND_DATAW wFindData;
res = FindNextFileW(dirp->handle, &wFindData);
if (res) {
dirp->end = dirp->start + newsize;
dirp->nfiles++;
}
- else
+ else {
dirp->curr = NULL;
+ if (dirp->handle != INVALID_HANDLE_VALUE) {
+ FindClose(dirp->handle);
+ dirp->handle = INVALID_HANDLE_VALUE;
+ }
+ }
}
return &(dirp->dirstr);
}
DllExport long
win32_telldir(DIR *dirp)
{
- return (dirp->curr - dirp->start);
+ return dirp->curr ? (dirp->curr - dirp->start) : -1;
}
DllExport void
win32_seekdir(DIR *dirp, long loc)
{
- dirp->curr = dirp->start + loc;
+ dirp->curr = loc == -1 ? NULL : dirp->start + loc;
}
/* Rewinddir resets the string pointer to the start */
return 1;
}
+/* duplicate a open DIR* for interpreter cloning */
+DllExport DIR *
+win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param)
+{
+ dVAR;
+ PerlInterpreter *const from = param->proto_perl;
+ PerlInterpreter *const to = PERL_GET_THX;
+
+ long pos;
+ DIR *dup;
+
+ /* switch back to original interpreter because win32_readdir()
+ * might Renew(dirp->start).
+ */
+ if (from != to) {
+ PERL_SET_THX(from);
+ }
+
+ /* mark current position; read all remaining entries into the
+ * cache, and then restore to current position.
+ */
+ pos = win32_telldir(dirp);
+ while (win32_readdir(dirp)) {
+ /* read all entries into cache */
+ }
+ win32_seekdir(dirp, pos);
+
+ /* switch back to new interpreter to allocate new DIR structure */
+ if (from != to) {
+ PERL_SET_THX(to);
+ }
+
+ Newx(dup, 1, DIR);
+ memcpy(dup, dirp, sizeof(DIR));
+
+ Newx(dup->start, dirp->size, char);
+ memcpy(dup->start, dirp->start, dirp->size);
+
+ dup->end = dup->start + (dirp->end - dirp->start);
+ if (dirp->curr)
+ dup->curr = dup->start + (dirp->curr - dirp->start);
+
+ return dup;
+}
/*
* various stubs
DllExport void win32_seekdir(DIR *dirp, long loc);
DllExport void win32_rewinddir(DIR *dirp);
DllExport int win32_closedir(DIR *dirp);
+DllExport DIR* win32_dirp_dup(DIR *const dirp, CLONE_PARAMS *const param);
DllExport char* win32_getenv(const char *name);
DllExport int win32_putenv(const char *name);