Posted to tcl by colin at Mon Jun 25 05:56:58 GMT 2012view raw

  1. proc quopar {str {q \"}} {
  2. set depth 0
  3. set result {}
  4. foreach c [split $str ""] {
  5. if {$c eq $q} {
  6. if {[info exists run]} {
  7. lappend result $depth $run
  8. unset run
  9. }
  10. set depth [expr {($depth+1)%2}]
  11. } else {
  12. append run $c
  13. }
  14. }
  15.  
  16. if {$depth > 0} {
  17. error "quopar dangling '$q' in '$str'"
  18. }
  19. if {[info exists run]} {
  20. lappend result $depth $run
  21. }
  22. return $result
  23. }
  24.  
  25. if {[info exists argv0] && $argv0 eq [info script]} {
  26. package require tcltest
  27. namespace import ::tcltest::*
  28. verbose {pass fail error}
  29. set count 0
  30. foreach {str result} {
  31. {""} ""
  32. {""""} ""
  33. {"moop"} "1 moop"
  34. {pebbles "fred wilma" bambam "barney betty"} "0 {pebbles } 1 {fred wilma} 0 { bambam } 1 {barney betty}"
  35. } {
  36. test quopar-[incr count] {} -body {
  37. quopar $str
  38. } -result $result
  39. }
  40.  
  41. foreach {str} {
  42. {"}
  43. {"""}
  44. } {
  45. test quopar-[incr count] {} -body {
  46. quopar $str
  47. } -match glob -result * -returnCodes 1
  48. }
  49. }