diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rwxr-xr-x | embed.pl | 18 | ||||
| -rw-r--r-- | ext/Encode/Encode.xs | 8 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 7 | ||||
| -rw-r--r-- | ext/PerlIO/Via/Via.xs | 9 | ||||
| -rw-r--r-- | perl.h | 2 | ||||
| -rw-r--r-- | perlio.c | 67 | ||||
| -rw-r--r-- | perlio.h | 2 | ||||
| -rw-r--r-- | perliol.h | 5 | ||||
| -rw-r--r-- | pod/perlapi.pod | 48 | ||||
| -rw-r--r-- | proto.h | 18 | ||||
| -rw-r--r-- | sv.c | 20 | ||||
| -rw-r--r-- | sv.h | 10 | ||||
| -rw-r--r-- | win32/win32io.c | 14 |
14 files changed, 140 insertions, 90 deletions
@@ -2360,7 +2360,7 @@ #define any_dup(a,b) Perl_any_dup(aTHX_ a,b) #define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c) #define re_dup(a,b) Perl_re_dup(aTHX_ a,b) -#define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b) +#define fp_dup(a,b,c) Perl_fp_dup(aTHX_ a,b,c) #define dirp_dup(a) Perl_dirp_dup(aTHX_ a) #define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b) #define mg_dup(a,b) Perl_mg_dup(aTHX_ a,b) @@ -1940,17 +1940,17 @@ Ap |void |newMYSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block p |OP * |my_attrs |OP *o|OP *attrs p |void |boot_core_xsutils #if defined(USE_ITHREADS) -Ap |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max|clone_params* param -Ap |PERL_SI*|si_dup |PERL_SI* si|clone_params* param -Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|clone_params* param +Ap |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max|CLONE_PARAMS* param +Ap |PERL_SI*|si_dup |PERL_SI* si|CLONE_PARAMS* param +Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|CLONE_PARAMS* param Ap |void* |any_dup |void* v|PerlInterpreter* proto_perl -Ap |HE* |he_dup |HE* e|bool shared|clone_params* param -Ap |REGEXP*|re_dup |REGEXP* r|clone_params* param -Ap |PerlIO*|fp_dup |PerlIO* fp|char type +Ap |HE* |he_dup |HE* e|bool shared|CLONE_PARAMS* param +Ap |REGEXP*|re_dup |REGEXP* r|CLONE_PARAMS* param +Ap |PerlIO*|fp_dup |PerlIO* fp|char type|CLONE_PARAMS* param Ap |DIR* |dirp_dup |DIR* dp -Ap |GP* |gp_dup |GP* gp|clone_params* param -Ap |MAGIC* |mg_dup |MAGIC* mg|clone_params* param -Ap |SV* |sv_dup |SV* sstr|clone_params* param +Ap |GP* |gp_dup |GP* gp|CLONE_PARAMS* param +Ap |MAGIC* |mg_dup |MAGIC* mg|CLONE_PARAMS* param +Ap |SV* |sv_dup |SV* sstr|CLONE_PARAMS* param #if defined(HAVE_INTERP_INTERN) Ap |void |sys_intern_dup |struct interp_intern* src \ |struct interp_intern* dst diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs index f3e8738836..e01959cd9a 100644 --- a/ext/Encode/Encode.xs +++ b/ext/Encode/Encode.xs @@ -325,6 +325,13 @@ PerlIOEncode_tell(PerlIO *f) return b->posn; } +PerlIO * +PerlIOEncode_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params) +{ + /* FIXME - Almost certainly needs more work */ + return PerlIOBase_dup(aTHX_ f, o, params); +} + PerlIO_funcs PerlIO_encode = { "encoding", sizeof(PerlIOEncode), @@ -334,6 +341,7 @@ PerlIO_funcs PerlIO_encode = { PerlIOBuf_open, PerlIOEncode_getarg, PerlIOBase_fileno, + PerlIOEncode_dup, PerlIOBuf_read, PerlIOBuf_unread, PerlIOBuf_write, diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index d8ee701b59..9fd6a2fde3 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -236,6 +236,12 @@ PerlIOScalar_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const c return NULL; } +PerlIO * +PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) +{ + /* FIXME - Needs more work */ + return PerlIOBase_dup(aTHX_ f, o, param); +} PerlIO_funcs PerlIO_scalar = { "Scalar", @@ -246,6 +252,7 @@ PerlIO_funcs PerlIO_scalar = { PerlIOScalar_open, NULL, PerlIOScalar_fileno, + PerlIOScalar_dup, PerlIOBase_read, PerlIOScalar_unread, PerlIOScalar_write, diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs index fcf316c3fc..2e029dbded 100644 --- a/ext/PerlIO/Via/Via.xs +++ b/ext/PerlIO/Via/Via.xs @@ -54,7 +54,6 @@ PerlIOVia_fetchmethod(pTHX_ PerlIOVia *s,char *method,CV **save) { return *save = (CV *) -1; } - } SV * @@ -492,6 +491,13 @@ PerlIOVia_eof(PerlIO *f) return (result) ? SvIV(result) : PerlIOBase_eof(f); } +PerlIO * +PerlIOVia_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) +{ + /* FIXME - Needs more work */ + return PerlIOBase_dup(aTHX_ f, o, param); +} + PerlIO_funcs PerlIO_object = { "Via", sizeof(PerlIOVia), @@ -501,6 +507,7 @@ PerlIO_funcs PerlIO_object = { NULL, /* PerlIOVia_open, */ PerlIOVia_getarg, PerlIOVia_fileno, + PerlIOVia_dup, PerlIOVia_read, PerlIOVia_unread, PerlIOVia_write, @@ -1632,6 +1632,8 @@ typedef struct mgvtbl MGVTBL; typedef union any ANY; typedef struct ptr_tbl_ent PTR_TBL_ENT_t; typedef struct ptr_tbl PTR_TBL_t; +typedef struct clone_params CLONE_PARAMS; + #include "handy.h" @@ -974,16 +974,11 @@ PerlIO__close(PerlIO *f) #undef PerlIO_fdupopen PerlIO * -PerlIO_fdupopen(pTHX_ PerlIO *f) +PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param) { if (f && *f) { - char buf[8]; - int fd = PerlLIO_dup(PerlIO_fileno(f)); - PerlIO *new = PerlIO_fdopen(fd, PerlIO_modestr(f, buf)); - if (new) { - Off_t posn = PerlIO_tell(f); - PerlIO_seek(new, posn, SEEK_SET); - } + PerlIO_funcs *tab = PerlIOBase(f)->tab; + PerlIO *new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param); return new; } else { @@ -1984,29 +1979,51 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, } } -PerlIO * -PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param) +SV * +PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param) { - PerlIO_funcs *self = PerlIOBase(o)->tab; - SV *arg = Nullsv; - char buf[8]; - if (self->Getarg) { - arg = (*self->Getarg)(o); + if (!arg) + return Nullsv; #ifdef sv_dup - if (arg) { - arg = sv_dup(arg, param); - } + if (param) { + return sv_dup(arg, param); + } + else { + return newSVsv(arg); + } +#else + return newSVsv(arg); #endif +} + +PerlIO * +PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) +{ + PerlIO *nexto = PerlIONext(o); + if (*nexto) { + PerlIO_funcs *tab = PerlIOBase(nexto)->tab; + f = (*tab->Dup)(aTHX_ f, nexto, param); } - if (!f) { - f = PerlIO_allocate(aTHX); + if (f) { + PerlIO_funcs *self = PerlIOBase(o)->tab; + SV *arg = Nullsv; + char buf[8]; + if (self->Getarg) { + arg = (*self->Getarg)(o); + if (arg) { + arg = PerlIO_sv_dup(aTHX_ arg, param); + } + } + f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); + if (!f && arg) { + SvREFCNT_dec(arg); + } } - f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); return f; } PerlIO * -PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param) +PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) { PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix); int fd = PerlLIO_dup(os->fd); @@ -2513,7 +2530,7 @@ PerlIOStdio_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt) #endif PerlIO * -PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param) +PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) { return NULL; } @@ -3010,7 +3027,7 @@ PerlIOBuf_set_ptrcnt(PerlIO *f, STDCHAR * ptr, SSize_t cnt) } PerlIO * -PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param) +PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) { return NULL; } @@ -3738,7 +3755,7 @@ PerlIOMmap_close(PerlIO *f) } PerlIO * -PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param) +PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param) { return NULL; } @@ -324,7 +324,7 @@ extern int PerlIO_getpos(PerlIO *, SV *); extern int PerlIO_setpos(PerlIO *, SV *); #endif #ifndef PerlIO_fdupopen -extern PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *); +extern PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *); #endif #if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO) extern char *PerlIO_modestr(PerlIO *, char *buf); @@ -26,7 +26,7 @@ struct _PerlIO_funcs { PerlIO *old, int narg, SV **args); SV *(*Getarg) (PerlIO *f); IV (*Fileno) (PerlIO *f); - PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, clone_params *param); + PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param); /* Unix-like functions - cf sfio line disciplines */ SSize_t(*Read) (PerlIO *f, void *vbuf, Size_t count); SSize_t(*Unread) (PerlIO *f, const void *vbuf, Size_t count); @@ -120,7 +120,7 @@ extern SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n); /* Generic, or stub layer functions */ extern IV PerlIOBase_fileno(PerlIO *f); -extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param); +extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param); extern IV PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg); extern IV PerlIOBase_popped(PerlIO *f); extern SSize_t PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count); @@ -152,6 +152,7 @@ typedef struct { IV oneword; /* Emergency buffer */ } PerlIOBuf; +extern SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param); extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char *mode, int fd, int imode, diff --git a/pod/perlapi.pod b/pod/perlapi.pod index a60c2c61a6..ad4d3e45b2 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -2191,7 +2191,7 @@ Found in file sv.h Expands the character buffer in the SV so that it has room for the indicated number of bytes (remember to reserve space for an extra trailing -NUL character). Calls C<sv_grow> to perform the expansion if necessary. +NUL character). Calls C<sv_grow> to perform the expansion if necessary. Returns a pointer to the character buffer. char * SvGROW(SV* sv, STRLEN len) @@ -2397,22 +2397,22 @@ which guarantees to evaluate sv only once. =for hackers Found in file sv.h -=item SvNVX +=item SvNVx -Returns the raw value in the SV's NV slot, without checks or conversions. -Only use when you are sure SvNOK is true. See also C<SvNV()>. +Coerces the given SV to a double and returns it. Guarantees to evaluate +sv only once. Use the more efficent C<SvNV> otherwise. - NV SvNVX(SV* sv) + NV SvNVx(SV* sv) =for hackers Found in file sv.h -=item SvNVx +=item SvNVX -Coerces the given SV to a double and returns it. Guarantees to evaluate -sv only once. Use the more efficent C<SvNV> otherwise. +Returns the raw value in the SV's NV slot, without checks or conversions. +Only use when you are sure SvNOK is true. See also C<SvNV()>. - NV SvNVx(SV* sv) + NV SvNVX(SV* sv) =for hackers Found in file sv.h @@ -2606,21 +2606,21 @@ Like C<SvPV_nolen>, but converts sv to uft8 first if necessary. =for hackers Found in file sv.h -=item SvPVx +=item SvPVX -A version of C<SvPV> which guarantees to evaluate sv only once. +Returns a pointer to the physical string in the SV. The SV must contain a +string. - char* SvPVx(SV* sv, STRLEN len) + char* SvPVX(SV* sv) =for hackers Found in file sv.h -=item SvPVX +=item SvPVx -Returns a pointer to the physical string in the SV. The SV must contain a -string. +A version of C<SvPV> which guarantees to evaluate sv only once. - char* SvPVX(SV* sv) + char* SvPVx(SV* sv, STRLEN len) =for hackers Found in file sv.h @@ -2827,19 +2827,19 @@ false, defined or undefined. Does not handle 'get' magic. =for hackers Found in file sv.h -=item SvTYPE - -Returns the type of the SV. See C<svtype>. +=item svtype - svtype SvTYPE(SV* sv) +An enum of flags for Perl types. These are found in the file B<sv.h> +in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. =for hackers Found in file sv.h -=item svtype +=item SvTYPE -An enum of flags for Perl types. These are found in the file B<sv.h> -in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. +Returns the type of the SV. See C<svtype>. + + svtype SvTYPE(SV* sv) =for hackers Found in file sv.h @@ -2973,7 +2973,7 @@ Found in file sv.h =item sv_2bool This function is only called on magical items, and is only used by -sv_true() or its macro equivalent. +sv_true() or its macro equivalent. bool sv_2bool(SV* sv) @@ -937,17 +937,17 @@ PERL_CALLCONV void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, O PERL_CALLCONV OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs); PERL_CALLCONV void Perl_boot_core_xsutils(pTHX); #if defined(USE_ITHREADS) -PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max, clone_params* param); -PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si, clone_params* param); -PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, clone_params* param); +PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max, CLONE_PARAMS* param); +PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si, CLONE_PARAMS* param); +PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, CLONE_PARAMS* param); PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl); -PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared, clone_params* param); -PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r, clone_params* param); -PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type); +PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared, CLONE_PARAMS* param); +PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r, CLONE_PARAMS* param); +PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type, CLONE_PARAMS* param); PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp); -PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, clone_params* param); -PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg, clone_params* param); -PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr, clone_params* param); +PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, CLONE_PARAMS* param); +PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg, CLONE_PARAMS* param); +PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr, CLONE_PARAMS* param); #if defined(HAVE_INTERP_INTERN) PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst); #endif @@ -123,7 +123,7 @@ Private API to rest of sv.c Public API: - sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas() + sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas() =cut @@ -3198,7 +3198,7 @@ Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp) =for apidoc sv_2bool This function is only called on magical items, and is only used by -sv_true() or its macro equivalent. +sv_true() or its macro equivalent. =cut */ @@ -4280,8 +4280,8 @@ Perl_sv_catsv_flags(pTHX_ SV *dsv, register SV *ssv, I32 flags) if ((spv = SvPV(ssv, slen))) { /* sutf8 and dutf8 were type bool, but under USE_ITHREADS, gcc version 2.95.2 20000220 (Debian GNU/Linux) for - Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously - get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though + Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously + get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though dsv->sv_flags doesn't have that bit set. Andy Dougherty 12 Oct 2001 */ @@ -8376,7 +8376,7 @@ ptr_table_* functions. #define gv_dup_inc(s,t) (GV*)SvREFCNT_inc(sv_dup((SV*)s,t)) #define SAVEPV(p) (p ? savepv(p) : Nullch) #define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch) - + /* Duplicate a regexp. Required reading: pregcomp() and pregfree() in regcomp.c. AMS 20010712 */ @@ -8480,7 +8480,7 @@ Perl_re_dup(pTHX_ REGEXP *r, clone_params *param) /* duplicate a file handle */ PerlIO * -Perl_fp_dup(pTHX_ PerlIO *fp, char type) +Perl_fp_dup(pTHX_ PerlIO *fp, char type,clone_params *param) { PerlIO *ret; if (!fp) @@ -8492,7 +8492,7 @@ Perl_fp_dup(pTHX_ PerlIO *fp, char type) return ret; /* create anew and remember what it is */ - ret = PerlIO_fdupopen(aTHX_ fp); + ret = PerlIO_fdupopen(aTHX_ fp, param); ptr_table_store(PL_ptr_table, fp, ret); return ret; } @@ -9820,10 +9820,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, for(i = 1; i <= len; i++) { if(SvREPADTMP(regexen[i])) { av_push(PL_regex_padav, sv_dup_inc(regexen[i], param)); - } else { + } else { av_push(PL_regex_padav, SvREFCNT_inc( - newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *, + newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *, SvIVX(regexen[i])), param))) )); } @@ -10308,7 +10308,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; } - + /* Call the ->CLONE method, if it exists, for each of the stashes identified by sv_dup() above. */ @@ -13,7 +13,7 @@ /* =for apidoc AmU||svtype -An enum of flags for Perl types. These are found in the file B<sv.h> +An enum of flags for Perl types. These are found in the file B<sv.h> in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. =for apidoc AmU||SVt_PV @@ -646,7 +646,7 @@ and leaves the UTF8 status as it was. #define SvAMAGIC_on(sv) (SvFLAGS(sv) |= SVf_AMAGIC) #define SvAMAGIC_off(sv) (SvFLAGS(sv) &= ~SVf_AMAGIC) -#define SvGAMAGIC(sv) (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC)) +#define SvGAMAGIC(sv) (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC)) /* #define Gv_AMG(stash) \ @@ -1178,7 +1178,7 @@ Like C<SvSetMagicSV>, but does any set magic required afterwards. =for apidoc Am|char *|SvGROW|SV* sv|STRLEN len Expands the character buffer in the SV so that it has room for the indicated number of bytes (remember to reserve space for an extra trailing -NUL character). Calls C<sv_grow> to perform the expansion if necessary. +NUL character). Calls C<sv_grow> to perform the expansion if necessary. Returns a pointer to the character buffer. =cut @@ -1234,7 +1234,7 @@ Returns a pointer to the character buffer. #define CLONEf_KEEP_PTR_TABLE 2 #define CLONEf_CLONE_HOST 4 -typedef struct { +struct clone_params { AV* stashes; UV flags; -} clone_params; +}; diff --git a/win32/win32io.c b/win32/win32io.c index b707172b6d..6152647a74 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -189,12 +189,12 @@ PerlIOWin32_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const ch s->h = h; s->fd = fd; s->refcnt = 1; - if (fd >= 0) + if (fd >= 0) { - fdtable[fd] = s; + fdtable[fd] = s; if (fd > max_open_fd) max_open_fd = fd; - } + } return f; } if (f) @@ -294,6 +294,13 @@ PerlIOWin32_close(PerlIO *f) return 0; } +PerlIO * +PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params) +{ + /* Almost certainly needs more work */ + return PerlIOBase_dup(aTHX_ f, o, params); +} + PerlIO_funcs PerlIO_win32 = { "win32", sizeof(PerlIOWin32), @@ -303,6 +310,7 @@ PerlIO_funcs PerlIO_win32 = { PerlIOWin32_open, NULL, /* getarg */ PerlIOWin32_fileno, + PerlIOWin32_dup, PerlIOWin32_read, PerlIOBase_unread, PerlIOWin32_write, |