Tcl Source Code

Artifact 264906d18432c8243425155f9b16b43be19a3bbc:

Attachment "info_frame.tcl" to ticket [2933089fff] added by cosmoweezer 2010-01-16 04:02:51.

---

proc print_one {} {
	puts "one"
}

proc test_info_frame {} {

	set x 1
	set y x
	
	puts "=================< 14 should be source line! >==============="
	if "$x != 1" {
		puts "not one"
	} else {
		print_one
	}

	if "2 != 1" {
		puts "not one"
	} else {
		print_one
	}

	puts "=================< 27 should be source line! >==============="
	if { $x != 1 } {
		puts "not one"
	} else {
		print_one
	}
	
	# Uh-oh!
	puts "=================< 35 should be source line not 14! >==============="
	if "$$y != 1" {
		puts "not one"
	} else {
		print_one
	}

}




proc get_frame_info { cmd_str op } {

	set level [info frame]
	#puts "============================"
	#puts "$level [info frame $level]"
	incr level -1
	#puts "$level [info frame $level]"
	incr level -1
	while { $level > 0 } {
	puts "$level [info frame $level]"
	incr level -1
	}
}


trace add execution print_one enter get_frame_info
puts "=================< 60 should be source line! >==============="
print_one
test_info_frame;
trace remove execution print_one enter get_frame_info