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包。我不想用＆＃39; vwait＆＃39;来阻止父线程。否则我将无法通知DB子线程仍在运行。事实证明这是不可靠的，因为偶尔我存储的线程ID是'processThreadId＆＃39;将在我的主题＆proc; proc执行命令{}＆＃39;之前退出饰面。

所以我的问题是 - 有一个可靠的方法让父线程（主线程）跟踪一个子线程是否仍然在运行，而没有阻止父线程使用＆＃39; vwait＆＃39;？

Answer 1

如果您拥有工作线程的ID，则可以使用thread::exists来查询它是否仍然存在。它只需要id作为参数，并返回一个布尔值，这应该是你需要的。

然而，在您提出问题后，线程可能会立即死亡;无法在真正的通用异步系统中阻止这种情况。我更喜欢安排工作线程在完成后发回消息，一旦收到消息，我知道一切都已完成。我经常喜欢在发送＆＃34;工作项目和＃34;线程，而不仅仅是简单的消息。

Answer 2

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

本质上，我创建了一个线程:: mutex并在父线程中获取锁定。我然后线程::发送到我的工作线程的互斥锁句柄。然后父线程循环，尝试重新锁定互斥锁并捕获/忽略＆＃34;从同一线程中锁定相同的专用互斥锁两次＆＃34;错误信息。当＆＃34; thread :: mutex lock＆＃34;时，父线程将跳出while循环。不会抛出错误。

工作线程通过其命令列表并调用＆＃34; thread :: mutex unlock＆＃34;就在退货声明之前。我还需要包装＆＃34; executeCommand＆＃34;在catch语句中，以便在工作线程发生意外错误时解锁互斥锁。

因此，被锁定的互斥锁代表工作线程正在运行，一旦它被解锁，它就没有更多的命令可以运行。

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线程仍在运行

2 个答案: