Tcl Source Code

Artifact 84aab45a56270d9d2b2cf83157a507c96e1d2823:

Attachment "info_frame_3.tcl" to ticket [3156499fff] added by cosmoweezer 2011-02-16 22:34:30.

---

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

namespace eval ns_test_info_frame {
	proc test_proc {} {
	}
	
	proc test_harness {} {
		puts "\n=================< local namespace ::proc call is okay >===============";
		test_proc;
		puts "\n=================< explicit ::namespace::proc call is also okay >===============";
		::ns_test_info_frame::test_proc;
		puts "\n=================< Uh-oh! -1 should not be source line! >==============="
		[namespace current]::test_proc;
	}
	
	trace add execution ::ns_test_info_frame::test_proc enter get_frame_info
	test_harness;
	trace remove execution ::ns_test_info_frame::test_proc enter get_frame_info
}