Posted to tcl by colin at Mon Jun 25 05:47:39 GMT 2012view raw
- 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
- }
- }