Posted to tcl by colin at Mon Jun 25 05:59:54 GMT 2012view raw

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