parsing parentheses

proc parsplit {str {l (} {r )}} {
    set depth 0
    set result {}
    foreach c [split $str ""] {
	if {$c eq $l} {
	    # OPEN
	    if {[info exists run]} {
		lappend result $depth $run
		unset run
	    }
	    incr depth
	} elseif {$c eq $r} {
	    # CLOSE
	    if {$depth > 0} {
		if {[info exists run]} {
		    lappend result $depth $run
		    unset run
		}
	    } else {
		error "parsplit unbalanced '$l$r' in '$str'"
	    }
	    incr depth -1
	} else {
	    append run $c
	}
    }
    if {$depth > 0} {
	error "parsplit dangling '$l' in '$str'"
    }
    if {[info exists run]} {
	lappend result $depth $run
    }
    return $result
}

if {[info exists argv0] && $argv0 eq [info script]} {
    package require tcltest
    namespace import ::tcltest::*
    verbose {pass fail error}
    set count 0
    foreach {str result} {
	() ""
	(()) ""
	(moop) "1 moop"
	"pebbles (fred wilma) bambam (barney betty)" "0 {pebbles } 1 {fred wilma} 0 { bambam } 1 {barney betty}"
	"zero (one (two (three (four (five)))))" "0 {zero } 1 {one } 2 {two } 3 {three } 4 {four } 5 five"
    } {
	test parsplit-[incr count] {} -body {
	    parsplit $str
	} -result $result
    }

    foreach {str} {
	"(((()"
	")))"
    } {
	test parsplit-[incr count] {} -body {
	    parsplit $str
	} -match glob -result * -returnCodes 1
    }

}