TCL 线程：跟踪子 Tcl 线程仍然运行

Question

我遇到了确定 Tcl 线程是否仍然运行的问题。我的代码如下所示：

package require Thread
proc p1 {} {
    set tid [thread::create {
        #Child Thread
        proc executeCommand {} {  
            #Run several command line commands
            return 1
        }
        thread::wait
    }]
    set currentProcessID [twapi::get_current_process_id]
    set var ::p1results($tid)
    set $var ""

    #Get all threads before ::thread::send
    set beforeThreads [twapi::get_process_thread_ids $currentProcessID]

    ::thread::send -async $tid [list executeCommand {}] $var

    #Get all threads after ::thread::send
    set afterThreads [twapi::get_process_thread_ids $currentProcessID]

    #set processThreadId to be the difference between before and after twapi calls
    set processThreadId {}
    foreach threadId $afterThreads {
        if {[lsearch -exact $beforeThreads $threadId] == -1} {
            set processThreadId $threadId
        }
    }

    while {[lsearch -exact [twapi::get_process_thread_ids $currentProcessID] $processThreadId] > -1} {
        #Notify a database that child thread is still running 
        after 3000
    }

    vwait $var
    set result [set $var]
    unset $var
    ::thread::release $tid
    return $result
}

p1

如您所见，我目前正在跟踪子线程，它是从 ::thread::send 开始的，使用的是 TCL twapi 包。我不想用 'vwait' 阻塞父线程，否则我将无法通知 DB 子线程仍然是运行。这已被证明是不可靠的，因为偶尔我存储的线程 ID 'processThreadId' 会在我的线程 'proc executeCommand {}' 完成之前退出。

所以我的问题是 - 是否有一种可靠的方法让父线程（主线程）跟踪子线程是否仍然运行，而不用 'vwait' 阻塞父线程？

Answer 1

如果你有工作线程的id，你可以使用thread::exists查询它是否还活着。它只需要 id 作为参数，returns 一个布尔值，这应该正是你所需要的。

但是，线程可能会在您提出问题后立即死亡；在真正的通用异步系统中没有办法阻止这种情况。我更喜欢安排工作线程在完成后发回一条消息，一旦收到该消息，我就知道一切都已完成。我经常喜欢考虑将 "work items" 发送到线程，而不仅仅是简单的消息。

Answer 2

我使用 thread::mutex 锁解决了这个问题，它比我之前使用的 twapi 包可靠得多。

本质上，我创建一个thread::mutex并在父线程中获取锁。然后我 thread::send 到我的工作线程互斥句柄。然后父线程循环，尝试重新锁定互斥锁和 catching/ignoring "locking the same exclusive mutex twice from the same thread" 错误消息。当"thread::mutex lock"不抛出错误时，父线程会跳出while循环。

工作线程遍历其命令列表并在 return 语句之前调用 "thread::mutex unlock"。我还需要将 "executeCommand" 包装在 catch 语句中，以便在工作线程出现意外错误时解锁互斥体。

所以被锁定的互斥体代表工作线程运行ning，一旦它被解锁，它就没有更多的命令到运行。

package require Thread
proc p1 {} {
    set mutexHand [::thread::mutex create]
    set tid [thread::create {
        proc wrapCommad {mutHand} {
            if {[catch {set data [executeCommand]} err]} {
                thread::mutex unlock $mutHand
                return -code error $err
            }
            thread::mutex unlock $mutHand
            return $data
        }
        proc executeCommand {} {  
            #Run several command line commands
            return 1
        }
        thread::wait
    }]
    set var ::p1results($tid)
    set $var ""
    thread::mutex lock $mutexHand 
    ::thread::send -async $tid [list wrapCommand $mutexHand] $var

    while {1} {
        if {[catch {thread::mutex lock $mutexHand} err] } {
            puts "WORKER STILL RUNNING"
        } else {
            puts "WORKER NOT RUNNING"
            break;
        }
        after 3000
    }

    vwait $var
    thread::mutex unlock $mutexHand
    thread::mutex destroy $mutexHand
    set result [set $var]
    unset $var
    ::thread::release $tid
    return $result
}

p1

TCL 线程：跟踪子 Tcl 线程仍然运行

TCL Thread: Tracking that a child Tcl Thread is still running

multithreading

tcl

send

TCL 线程：跟踪子 Tcl 线程仍然 运行

TCL Thread: Tracking that a child Tcl Thread is still running

multithreading

tcl

send

TCL 线程：跟踪子 Tcl 线程仍然运行