aboutsummaryrefslogtreecommitdiff
path: root/tests/errors.tcl
blob: 37aff21db0538a66aa2e66a6bf340d2e3103ead1 (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
60
61
62
63
# 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 [file dirname [info script]]/dummy.tcl
		}
		badpackage {
			package require bogus
		}
		returncode {
			return -code error failure
		}
		badproc {
			error_badproc
		}
		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"
		}
	}
}

proc error_badproc {} {
	return [list missing bracket here
}