Tcl Source Code

Artifact 991d97e0f42a4e2c51bda4bece41e88710517126:

Attachment "info_frame_partTwo.tcl" to ticket [3156499fff] added by cosmoweezer 2011-01-13 01:53:59.

---

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;
set p1 "print_one"
puts "=================< Uh-oh! 64 should be source line! >==============="
$p1
proc test_proc {} {
	set p2 "rint_one"
	puts "=================< Uh-oh! 68 should be source line! >==============="
	p$p2
	puts "test_proc"
}
test_proc
trace remove execution print_one enter get_frame_info