Tcl Source Code

Artifact 80d60e61ce14539e24b17e4a771d594e645363f7:

Attachment "sr.tcl" to ticket [1692378fff] added by andreas_kupries 2007-04-03 00:45:38.

---

proc p {arg} {
    switch $arg {
	a {return A}
	b {return B}
	c {return C}
	d {return D}
	e {return E}
	f {return F}
	g {return G}
	h {return H}
	i {return I}
	j {return J}
	k {return K}
	l {return L}
	m {return M}
	n {return N}
	o {return O}
	p {return P}
	q {return Q}
	r {return R}
	s {return S}
	t {return T}
    }
}

proc q {arg} {
    switch -exact -- $arg {
	a {return A}
	b {return B}
	c {return C}
	d {return D}
	e {return E}
	f {return F}
	g {return G}
	h {return H}
	i {return I}
	j {return J}
	k {return K}
	l {return L}
	m {return M}
	n {return N}
	o {return O}
	p {return P}
	q {return Q}
	r {return R}
	s {return S}
	t {return T}
    }
}

# Take the time to bytecompile the procs out of the timing area
# p : Csaba's original
# q : optimize using -exact
p a ; q a

puts "[info patchlevel]"
puts "p/match   [time {p "a"} 100000]" ;# matching case
puts "p/!match  [time {p "x"} 100000]" ;# non-matching case

puts "q/match   [time {q "a"} 100000]" ;# matching case
puts "q/!match  [time {q "x"} 100000]" ;# non-matching case