Posted to tcl by aspect at Fri Nov 06 08:33:21 GMT 2015view pretty

proc check {obj} {
    set obj [uplevel 1 [list namespace which $obj]]
    puts "$obj is:"
    foreach what {object class metaclass} {
        puts "\t$what: [info object isa $what $obj]"
    }
}

    ::oo::class create Namedclass {
        self method create {name args} {
            tailcall my createWithNamespace $name $name {*}$args
        }
    }

    Namedclass create xx {
        superclass ::oo::class
    }

    check xx

    [info object namespace ::oo::class]::my createWithNamespace yy {
        superclass ::oo::class
    }

    check yy


    [info object namespace ::oo::class]::my createWithNamespace zz zz
    oo::define zz {
        superclass ::oo::class
    }

    check zz

#	::xx is:
#	        object: 1
#	        class: 0
#	        metaclass: 0
#	::yy is:
#	        object: 1
#	        class: 1
#	        metaclass: 0
#	::zz is:
#	        object: 1
#	        class: 1
#	        metaclass: 1