Posted to tcl by hypnotoad at Mon Jun 01 15:58:42 GMT 2015view pretty

package require oo::meta

oo::class create small_class {
  constructor {} {}
  method hello {} {puts hello}
}

oo::class create large_class {
  property deputy first {class small_class}
  property deputy second {class small_class}

  constructor {} {
    foreach {name desc} [my meta get deputy] {
       set class [dict get $desc class]
       set obj [$class create $name] 
       oo::objdefine [self] forward $name $obj
       oo::objdefine $obj forward parent [self]
    }

    method hello {} {
       foreach obj [my meta keys deputy] {
          $obj hello
       }
    }
}
 
large_class create myLargeObject
myLargeObject hello
myLargeObject first hello
myLargeObject second hello