Posted to tcl by aspect at Tue Jun 09 12:15:30 GMT 2015view raw

  1. Index: modules/ooutil/ooutil.tcl
  2. ==================================================================
  3. --- modules/ooutil/ooutil.tcl
  4. +++ modules/ooutil/ooutil.tcl
  5. @@ -89,17 +89,21 @@
  6. }
  7.  
  8. # Build this *almost* like a class method, but with extra care to avoid nuking
  9. # the existing method.
  10. oo::class create oo::class.Delegate {
  11. - method create {name {script ""}} {
  12. + method create {name args} {
  13. + if {![string match ::* $name]} {
  14. + set ns [uplevel 1 {namespace current}]
  15. + if {$ns eq "::"} {set ns ""}
  16. + set name ${ns}::${name}
  17. + }
  18. if {[string match *.Delegate $name]} {
  19. - return [next $name $script]
  20. + return [next $name {*}$args]
  21. }
  22. - set cls [next $name]
  23. - set delegate [oo::class create $cls.Delegate]
  24. - uplevel 1 [::list oo::define $cls $script]
  25. + set delegate [oo::class create $name.Delegate]
  26. + set cls [next $name {*}$args]
  27. set superdelegates [list $delegate]
  28. foreach c [info class superclass $cls] {
  29. set d $c.Delegate
  30. if {[info object isa object $d] && [info object isa class $d]} {
  31. lappend superdelegates $d
  32.  
  33. Index: modules/ooutil/ooutil.test
  34. ==================================================================
  35. --- modules/ooutil/ooutil.test
  36. +++ modules/ooutil/ooutil.test
  37. @@ -30,13 +30,41 @@
  38. }
  39. } -cleanup {
  40. namespace delete ooutiltest
  41. rename animal {}
  42. } -result {::ooutiltest::dog}
  43. +
  44. +test ooutil-classmethod-1 {test ooutil classmethod} -setup {
  45. + oo::class create ActiveRecord {
  46. + classmethod find args { puts "[self] called with arguments: $args" }
  47. + }
  48. + oo::class create Table {
  49. + superclass ActiveRecord
  50. + }
  51. +} -body {
  52. + Table find foo bar
  53. +} -cleanup {
  54. + rename ActiveRecord {}
  55. +} -output "::Table called with arguments: foo bar\n"
  56. +
  57. +test ooutil-classmethod-2 {test ooutil classmethod in namespace} -setup {
  58. + namespace eval testns {
  59. + oo::class create ActiveRecord {
  60. + classmethod find args { puts "[self] called with arguments: $args" }
  61. + }
  62. + oo::class create Table {
  63. + superclass ActiveRecord
  64. + }
  65. + }
  66. +} -body {
  67. + testns::Table find foo bar
  68. +} -cleanup {
  69. + namespace delete testns
  70. +} -output "::testns::Table called with arguments: foo bar\n"
  71. +
  72.  
  73. # Test properties
  74. -
  75. oo::class create foo {
  76. property color blue
  77.  
  78. constructor args {
  79. my InitializePublic
  80.  
  81.