diff options
| author | Jan Dubois <jand@activestate.com> | 2005-12-16 07:12:00 +0000 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgarciasuarez@gmail.com> | 2005-12-16 21:13:37 +0000 |
| commit | aeecf691f59fe1423b7011655dd5de7d5fbd2192 (patch) | |
| tree | c9ef1f79b643133f95c8a03c1820e666397dfe08 /win32/perlhost.h | |
| parent | 3043b442861dc32a5941608838b57d2e089a7e25 (diff) | |
| download | perl-aeecf691f59fe1423b7011655dd5de7d5fbd2192.tar.gz | |
RE: PeekMessage() call in win32\win32.c win32_async_check
Message-ID: <015901c60207$abd64210$d563a8c0@candy>
(Without the proposed alarm.t test)
p4raw-id: //depot/perl@26379
Diffstat (limited to 'win32/perlhost.h')
| -rw-r--r-- | win32/perlhost.h | 12 |
1 files changed, 12 insertions, 0 deletions
diff --git a/win32/perlhost.h b/win32/perlhost.h index 92d575795c..e2227e358f 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -1693,6 +1693,7 @@ win32_start_child(LPVOID arg) PerlInterpreter *my_perl = (PerlInterpreter*)arg; GV *tmpgv; int status; + HWND parent_message_hwnd; #ifdef PERL_SYNC_FORK static long sync_fork_id = 0; long id = ++sync_fork_id; @@ -1723,6 +1724,12 @@ win32_start_child(LPVOID arg) hv_clear(PL_pidstatus); #endif + /* create message window and tell parent about it */ + parent_message_hwnd = w32_message_hwnd; + w32_message_hwnd = win32_create_message_window(); + if (parent_message_hwnd != NULL) + PostMessage(parent_message_hwnd, WM_USER_MESSAGE, w32_pseudo_id, (LONG)w32_message_hwnd); + /* push a zero on the stack (we are the child) */ { dSP; @@ -1826,6 +1833,11 @@ PerlProcFork(struct IPerlProc* piPerl) id = win32_start_child((LPVOID)new_perl); PERL_SET_THX(aTHX); # else + if (w32_message_hwnd == INVALID_HANDLE_VALUE) + w32_message_hwnd = win32_create_message_window(); + new_perl->Isys_intern.message_hwnd = w32_message_hwnd; + w32_pseudo_child_message_hwnds[w32_num_pseudo_children] = + (w32_message_hwnd == NULL) ? NULL : INVALID_HANDLE_VALUE; # ifdef USE_RTL_THREAD_API handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child, (void*)new_perl, 0, (unsigned*)&id); |