diff options
| -rwxr-xr-x | embed.pl | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | objXSUB.h | 4 | ||||
| -rw-r--r-- | perl.c | 6 | ||||
| -rw-r--r-- | perlapi.c | 7 | ||||
| -rw-r--r-- | win32/perlhost.h | 7 | ||||
| -rw-r--r-- | win32/perllib.c | 24 | ||||
| -rw-r--r-- | win32/win32.h | 4 |
8 files changed, 43 insertions, 12 deletions
@@ -1445,7 +1445,7 @@ p |bool |do_aexec |SV* really|SV** mark|SV** sp p |bool |do_aexec5 |SV* really|SV** mark|SV** sp|int fd|int flag Ap |int |do_binmode |PerlIO *fp|int iotype|int flag p |void |do_chop |SV* asv|SV* sv -p |bool |do_close |GV* gv|bool not_implicit +Ap |bool |do_close |GV* gv|bool not_implicit p |bool |do_eof |GV* gv p |bool |do_exec |char* cmd #if !defined(WIN32) diff --git a/global.sym b/global.sym index ea77dfe001..c9ecd97bad 100644 --- a/global.sym +++ b/global.sym @@ -85,6 +85,7 @@ Perl_delimcpy Perl_die Perl_dounwind Perl_do_binmode +Perl_do_close Perl_do_open Perl_do_open9 Perl_dowantarray @@ -297,6 +297,10 @@ #define Perl_do_binmode pPerl->Perl_do_binmode #undef do_binmode #define do_binmode Perl_do_binmode +#undef Perl_do_close +#define Perl_do_close pPerl->Perl_do_close +#undef do_close +#define do_close Perl_do_close #if !defined(WIN32) #endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) @@ -764,7 +764,13 @@ perl_free(pTHXx) #if defined(PERL_OBJECT) PerlMem_free(this); #else +# if defined(PERL_IMPLICIT_SYS) && defined(WIN32) + void *host = w32_internal_host; PerlMem_free(aTHXx); + win32_delete_internal_host(host); +# else + PerlMem_free(aTHXx); +# endif #endif } @@ -606,6 +606,13 @@ Perl_do_binmode(pTHXo_ PerlIO *fp, int iotype, int flag) { return ((CPerlObj*)pPerl)->Perl_do_binmode(fp, iotype, flag); } + +#undef Perl_do_close +bool +Perl_do_close(pTHXo_ GV* gv, bool not_implicit) +{ + return ((CPerlObj*)pPerl)->Perl_do_close(gv, not_implicit); +} #if !defined(WIN32) #endif #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) diff --git a/win32/perlhost.h b/win32/perlhost.h index 02b9cb4bc4..cac05b2832 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1719,6 +1719,13 @@ restart: PL_main_root = Nullop; } + /* close the std handles to avoid fd leaks */ + { + do_close(gv_fetchpv("STDIN", TRUE, SVt_PVIO), FALSE); + do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); + do_close(gv_fetchpv("STDERR", TRUE, SVt_PVIO), FALSE); + } + /* destroy everything (waits for any pseudo-forked children) */ perl_destruct(my_perl); perl_free(my_perl); diff --git a/win32/perllib.c b/win32/perllib.c index 6211ba7129..857aada247 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -143,6 +143,13 @@ perl_alloc(void) return my_perl; } +EXTERN_C void +win32_delete_internal_host(void *h) +{ + CPerlHost *host = (CPerlHost*)h; + delete host; +} + #ifdef PERL_OBJECT EXTERN_C void @@ -157,10 +164,7 @@ perl_construct(PerlInterpreter* my_perl) { win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); - CPerlHost* pHost = (CPerlHost*)w32_internal_host; - Perl_free(); - delete pHost; - PERL_SET_THX(NULL); + perl_free(my_perl); } } @@ -185,21 +189,19 @@ EXTERN_C void perl_free(PerlInterpreter* my_perl) { CPerlObj* pPerl = (CPerlObj*)my_perl; + void *host = w32_internal_host; #ifdef DEBUGGING - CPerlHost* pHost = (CPerlHost*)w32_internal_host; Perl_free(); - delete pHost; #else try { - CPerlHost* pHost = (CPerlHost*)w32_internal_host; Perl_free(); - delete pHost; } catch(...) { } #endif + win32_delete_internal_host(host); PERL_SET_THX(NULL); } @@ -207,10 +209,10 @@ EXTERN_C int perl_run(PerlInterpreter* my_perl) { CPerlObj* pPerl = (CPerlObj*)my_perl; + int retVal; #ifdef DEBUGGING - return Perl_run(); + retVal = Perl_run(); #else - int retVal; try { retVal = Perl_run(); @@ -220,8 +222,8 @@ perl_run(PerlInterpreter* my_perl) win32_fprintf(stderr, "Error: Runtime exception\n"); retVal = -1; } - return retVal; #endif + return retVal; } EXTERN_C int diff --git a/win32/win32.h b/win32/win32.h index 81bf5747a9..35d5bdfa98 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -337,6 +337,10 @@ extern int IsWin95(void); extern int IsWinNT(void); extern void win32_argv2utf8(int argc, char** argv); +#ifdef PERL_IMPLICIT_SYS +extern void win32_delete_internal_host(void *h); +#endif + extern char * staticlinkmodules[]; END_EXTERN_C |