0030430: Draw - command testgrid in parallel mode hangs if DRAW is launched without GUI
authorabv <abv@opencascade.com>
Thu, 10 Jan 2019 05:17:04 +0000 (08:17 +0300)
committerbugmaster <bugmaster@opencascade.com>
Thu, 10 Jan 2019 13:35:02 +0000 (16:35 +0300)
Ensure that initialization of Tcl interpretor is performed in the same thread where commands are evaluated.

Added test demo draw bug30430

src/Draw/Draw_Interpretor.cxx
src/Draw/Draw_Window.cxx
tests/demo/draw/bug30430 [new file with mode: 0644]

index 411fbf4..a5177e8 100644 (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;
index 2ffd7ee..41f7796 100644 (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);
diff --git a/tests/demo/draw/bug30430 b/tests/demo/draw/bug30430
new file mode 100644 (file)
index 0000000..4d20a13
--- /dev/null
@@ -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"