aboutsummaryrefslogtreecommitdiff
path: root/tests/errors.tcl
blob: 1105dfa23e9a6eb11317199bc9c3e983944eda31 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
# Package which can generate a variety of errors at known locations

proc error_generator {type} {
	switch $type {
		badcmd {
			bogus command called
		} 
		badvar {
			set bogus
		} 
		error {
			error bogus
		} 
		interpbadvar {
			set x "some $bogus text"
		} 
		interpbadcmd {
			set x "some $bogus text"
		} 
		package {
			package require dummy
		} 
		source {
			source dummy.tcl
		} 
		badpackage {
			package require bogus
		} 
		returncode {
			return -code error failure
		} 
		default {
			puts "Unknown type=$type"
		}
	}
}



# line 40: Some empty lines above so that line numbers don't change
proc error_caller {type {method call}} {
	switch $method {
		call {
			error_generator $type
		} 
		uplevel {
			uplevel 1 [list error_generator $type]
		} 
		eval {
			eval [list error_generator $type]
		} 
		evalstr {
			eval error_generator $type
		} 
		default {
			puts "Unknown method=$method"
		}
	}
}