From 8de8dacd023a4cae08d76bf4fa08f082d1ea41d6 Mon Sep 17 00:00:00 2001
From: abv <abv@opencascade.com>
Date: Thu, 10 Jan 2019 08:17:04 +0300
Subject: [PATCH] 0030430: Draw - command testgrid in parallel mode hangs if
 DRAW is launched without GUI

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 |  5 +---
 src/Draw/Draw_Window.cxx      | 31 +++++++++++------------
 tests/demo/draw/bug30430      | 46 +++++++++++++++++++++++++++++++++++
 3 files changed, 63 insertions(+), 19 deletions(-)
 create mode 100644 tests/demo/draw/bug30430

diff --git a/src/Draw/Draw_Interpretor.cxx b/src/Draw/Draw_Interpretor.cxx
index 411fbf45ed..a5177e8de9 100644
--- a/src/Draw/Draw_Interpretor.cxx
+++ b/src/Draw/Draw_Interpretor.cxx
@@ -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;
diff --git a/src/Draw/Draw_Window.cxx b/src/Draw/Draw_Window.cxx
index 2ffd7eeafd..41f779650f 100644
--- a/src/Draw/Draw_Window.cxx
+++ b/src/Draw/Draw_Window.cxx
@@ -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
index 0000000000..4d20a13c25
--- /dev/null
+++ b/tests/demo/draw/bug30430
@@ -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"