OpenCascade/occt
1
0
Fork 0
mirror of https://git.dev.opencascade.org/repos/occt.git synced 2025-04-03 17:56:21 +03:00
Code Packages Releases Activity

0030430: Draw - command testgrid in parallel mode hangs if DRAW is launched without GUI

Browse Source 
Ensure that initialization of Tcl interpretor is performed in the same thread where commands are evaluated.

Added test demo draw bug30430
This commit is contained in:
abv 2019-01-10 08:17:04 +03:00 committed by bugmaster
parent 9b4243f9bf
commit 8de8dacd02
3 changed files with 63 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/Draw/Draw_Interpretor.cxx
View File

@ -270,10 +270,7 @@ void Draw_Interpretor::add (const Standard_CString theCommandName,
Draw_Interpretor::CallBackData* theCallback,
const Standard_CString theGroup)
{
if (myInterp == NULL)
{
Init();
}
Standard_ASSERT_RAISE (myInterp != NULL, "Attempt to add command to Null interpretor");
Standard_PCharacter aName = (Standard_PCharacter )theCommandName;
Standard_PCharacter aHelp = (Standard_PCharacter )theHelp;

31
src/Draw/Draw_Window.cxx
View File

@ -32,7 +32,6 @@
extern Standard_Boolean Draw_Batch;
extern Standard_Boolean Draw_VirtualWindows;
static Tcl_Interp *interp; /* Interpreter for this application. */
static NCollection_List<Draw_Window::FCallbackBeforeTerminate> MyCallbacks;
void Draw_Window::AddCallbackBeforeTerminate(FCallbackBeforeTerminate theCB)
@ -1110,9 +1109,9 @@ Standard_Boolean Init_Appli()
{
Draw_Interpretor& aCommands = Draw::GetInterpretor();
aCommands.Init();
interp = aCommands.Interp();
Tcl_Interp *interp = aCommands.Interp();
Tcl_Init (interp);
Tcl_Init(interp) ;
try {
OCC_CATCH_SIGNALS
Tk_Init(interp) ;
@ -1302,7 +1301,7 @@ static void StdinProc(ClientData clientData, int )
*/
prompt:
if (tty) Prompt(interp, gotPartial);
if (tty) Prompt(Draw::GetInterpretor().Interp(), gotPartial);
} catch (Standard_Failure) {}
@ -2031,14 +2030,9 @@ bool volatile isTkLoopStarted = false;
Standard_Boolean Init_Appli(HINSTANCE hInst,
HINSTANCE hPrevInst, int nShow, HWND& hWndFrame )
{
Draw_Interpretor& aCommands = Draw::GetInterpretor();
DWORD IDThread;
HANDLE hThread;
console_semaphore = STOP_CONSOLE;
aCommands.Init();
interp = aCommands.Interp();
Tcl_Init(interp) ;
dwMainThreadId = GetCurrentThreadId();
@ -2050,14 +2044,18 @@ Standard_Boolean Init_Appli(HINSTANCE hInst,
0, // use default creation flags
&IDThread);
if (!hThread) {
cout << "Tcl/Tk main loop thread not created. Switching to batch mode..." << endl;
cout << "Failed to create Tcl/Tk main loop thread. Switching to batch mode..." << endl;
Draw_Batch = Standard_True;
Draw_Interpretor& aCommands = Draw::GetInterpretor();
aCommands.Init();
Tcl_Interp *interp = aCommands.Interp();
Tcl_Init(interp);
#ifdef _TK
try {
OCC_CATCH_SIGNALS
Tk_Init(interp) ;
} catch (Standard_Failure) {
cout <<" Pb au lancement de TK_Init "<<endl;
Tk_Init(interp);
} catch (Standard_Failure& anExcept) {
cout << "Failed to initialize Tk: " << anExcept.GetMessageString() << endl;
}
Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
@ -2262,6 +2260,11 @@ static DWORD WINAPI tkLoop(VOID)
{
Tcl_CreateExitHandler(exitProc, 0);
Draw_Interpretor& aCommands = Draw::GetInterpretor();
aCommands.Init();
Tcl_Interp *interp = aCommands.Interp();
Tcl_Init(interp);
// Work-around against issue with Tcl standard channels on Windows.
// These channels by default use OS handles owned by the system which
// may get invalidated e.g. by dup2() (see dlog command).
@ -2279,8 +2282,6 @@ static DWORD WINAPI tkLoop(VOID)
// ActiveState Tcl (at least 8.6.4) does not seem to do that, so channels
// need to be set into interpretor explicitly
{
Draw_Interpretor& aCommands = Draw::GetInterpretor();
Tcl_Channel aChannelIn = Tcl_GetStdChannel (TCL_STDIN);
Tcl_Channel aChannelOut = Tcl_GetStdChannel (TCL_STDOUT);
Tcl_Channel aChannelErr = Tcl_GetStdChannel (TCL_STDERR);

46
tests/demo/draw/bug30430 Normal file
View File

@ -0,0 +1,46 @@
# testgrid demo draw -overwrite
catch {cpulimit 10}
package require Thread
set NBTHREADS 1
set NBWORKERS 1
puts "Creating worker"
set worker [tpool::create -minworkers $NBWORKERS -maxworkers $NBWORKERS]
puts "Suspending worker"
tpool::suspend $worker
puts "Arranging jobs"
for {set i 1} {$i <= $NBTHREADS} {incr i} {
set job [tpool::post $worker "puts Executing_job_$i"]
puts "Job $i: $job"
# set job [tpool::post -nowait $worker "puts $i"]
set jobs($job) $job
}
puts "Resuming worker"
tpool::resume $worker
puts "Waiting while all threads complete"
after 1000
puts "Obtaining results"
while { [llength [array names jobs]] > 0 } {
puts "Queue: [array names jobs]"
foreach job [tpool::wait $worker [array names jobs]] {
puts -nonewline "Completed $job: "
puts "[tpool::get $worker $job]"
unset jobs($job)
}
}
puts "Releasing worker"
tpool::release $worker
catch {cpulimit 0}
puts "TEST COMPLETED"