Posted to tcl by colin at Mon Jun 25 05:47:39 GMT 2012view raw

  1. proc parsplit {str {l (} {r )}} {
  2. set depth 0
  3. set result {}
  4. foreach c [split $str ""] {
  5. if {$c eq $l} {
  6. # OPEN
  7. if {[info exists run]} {
  8. lappend result $depth $run
  9. unset run
  10. }
  11. incr depth
  12. } elseif {$c eq $r} {
  13. # CLOSE
  14. if {$depth > 0} {
  15. if {[info exists run]} {
  16. lappend result $depth $run
  17. unset run
  18. }
  19. } else {
  20. error "parsplit unbalanced '$l$r' in '$str'"
  21. }
  22. incr depth -1
  23. } else {
  24. append run $c
  25. }
  26. }
  27. if {$depth > 0} {
  28. error "parsplit dangling '$l' in '$str'"
  29. }
  30. if {[info exists run]} {
  31. lappend result $depth $run
  32. }
  33. return $result
  34. }
  35.  
  36. if {[info exists argv0] && $argv0 eq [info script]} {
  37. package require tcltest
  38. namespace import ::tcltest::*
  39. verbose {pass fail error}
  40. set count 0
  41. foreach {str result} {
  42. () ""
  43. (()) ""
  44. (moop) "1 moop"
  45. "pebbles (fred wilma) bambam (barney betty)" "0 {pebbles } 1 {fred wilma} 0 { bambam } 1 {barney betty}"
  46. "zero (one (two (three (four (five)))))" "0 {zero } 1 {one } 2 {two } 3 {three } 4 {four } 5 five"
  47. } {
  48. test parsplit-[incr count] {} -body {
  49. parsplit $str
  50. } -result $result
  51. }
  52.  
  53. foreach {str} {
  54. "(((()"
  55. ")))"
  56. } {
  57. test parsplit-[incr count] {} -body {
  58. parsplit $str
  59. } -match glob -result * -returnCodes 1
  60. }
  61.  
  62. }