Tcl Source Code

Artifact 01ebf79911756d2675f1aa82b0ff9bfda31e7629:

#!/bin/tcsh -f

# comment out next line \
exec tclsh8.3 $0 $argv:q

#exec /usr/local/opt/tcltk/8.4.5-debug/bin/tclsh8.4 $0 $argv:q

package require Thread

namespace eval DE {

	proc threadError { threadid errorInfo } {
		global DE::threadError
		set threadError 1
		return $threadError
	}

	proc texec { args } {
		global DE::thread DE::threadError errorInfo errorCode 
		global result

		set DE::threadError 0

		set thread [thread::create]
		thread::errorproc DE::threadError 

		set script {
			set result ""
			set filename tmp_[pid]

			set errorCheck 0
			set errorCheck [ catch { eval exec $program 2> $filename } result ]

			set lines ""
			if { $errorCheck > 0 } {
				set FILE [open $filename r]	
				set lines [read $FILE  [file size $filename]]
				close $FILE
				file delete $filename
				error "$lines"
			} else {
				file delete $filename
				#set output
			}
			set result [list $result $lines $errorCheck]

			#set result; # this works
			return $result ; # this doesn't
		}

		thread::send -async $thread "set program \"$args\"; $script" result

		vwait result

		if { $DE::threadError != 0 } { 
			error "Error executing command $args:\n$result\n$errorInfo"
		}

		if { [string length [lindex $result 1]] != 0 } {
			puts stderr [lindex $result 1]
		}

		return [lindex $result 0]
	}

}

if { 1 } {
	catch {
		 puts [DE::texec ./print.tcl]
	} output
	puts "$output"
}