diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2017-03-29 19:07:44 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2017-03-29 19:07:44 (GMT) |
commit | ff6f4d8dc03f67ebc6252b9ace70ef65d9f8826d (patch) | |
tree | 323707864f9531c31123118358537f8f27305c68 | |
parent | 2bcac0715108b8c7158aa60f240c8c5dd26ad352 (diff) | |
parent | 41c4744202449c4e812732d5ff09104f866c1409 (diff) | |
download | tcl-ff6f4d8dc03f67ebc6252b9ace70ef65d9f8826d.zip tcl-ff6f4d8dc03f67ebc6252b9ace70ef65d9f8826d.tar.gz tcl-ff6f4d8dc03f67ebc6252b9ace70ef65d9f8826d.tar.bz2 |
[900cb0284bc] Ensure that masking pseudo-methods used for export management are not introspectable directly.
-rw-r--r-- | generic/tclOOCall.c | 1 | ||||
-rw-r--r-- | tests/oo.test | 38 |
2 files changed, 39 insertions, 0 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 8003345..ac0b94d 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -619,6 +619,7 @@ AddClassMethodNames( int isWanted = (!(flags & PUBLIC_METHOD) || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0; + isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0); Tcl_SetHashValue(hPtr, INT2PTR(isWanted)); } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION) && mPtr->typePtr != NULL) { diff --git a/tests/oo.test b/tests/oo.test index ccb05c1..e03911b 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2241,6 +2241,44 @@ test oo-17.10 {OO: class introspection} -setup { oo::define foo unexport {*}[info class methods foo -all] info class methods foo -all } -result {} +set stdmethods {<cloned> destroy eval unknown variable varname} +test oo-17.11 {OO: object method unexport (bug 900cb0284bc)} -setup { + oo::object create o + oo::objdefine o unexport m +} -body { + lsort [info object methods o -all -private] +} -cleanup { + o destroy +} -result $stdmethods +test oo-17.12 {OO: instance method unexport (bug 900cb0284bc)} -setup { + oo::class create c + c create o + oo::objdefine o unexport m +} -body { + lsort [info object methods o -all -private] +} -cleanup { + o destroy + c destroy +} -result $stdmethods +test oo-17.13 {OO: class method unexport (bug 900cb0284bc)} -setup { + oo::class create c + oo::define c unexport m +} -body { + lsort [info class methods c -all -private] +} -cleanup { + c destroy +} -result $stdmethods +test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup { + oo::class create c + oo::define c unexport m + c create o +} -body { + lsort [info object methods o -all -private] +} -cleanup { + o destroy + c destroy +} -result $stdmethods + test oo-18.1 {OO: define command support} { list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo |