diff options
| -rw-r--r-- | generic/tclOOCall.c | 9 | ||||
| -rw-r--r-- | generic/tclOOInfo.c | 10 | ||||
| -rw-r--r-- | generic/tclOOInt.h | 1 | ||||
| -rw-r--r-- | tests/oo.test | 36 |
4 files changed, 52 insertions, 4 deletions
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 5fd0c2a..bc84da0 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -44,18 +44,25 @@ struct ChainBuilder { #define MIXIN_CONSISTENT(flags) \ (((flags) & OBJECT_MIXIN) || \ !((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN)) + /* - * Note that the flag bit PRIVATE_METHOD has a confusing name. + * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for + * Itcl's special type of private. */ + #define IS_PUBLIC(mPtr) \ (((mPtr)->flags & PUBLIC_METHOD) != 0) #define IS_UNEXPORTED(mPtr) \ + (((mPtr)->flags & SCOPE_FLAGS) == 0) +#define IS_ITCLPRIVATE(mPtr) \ (((mPtr)->flags & PRIVATE_METHOD) != 0) #define IS_PRIVATE(mPtr) \ (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0) #define WANT_PUBLIC(flags) \ (((flags) & PUBLIC_METHOD) != 0) #define WANT_UNEXPORTED(flags) \ + (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0) +#define WANT_ITCLPRIVATE(flags) \ (((flags) & PRIVATE_METHOD) != 0) #define WANT_PRIVATE(flags) \ (((flags) & TRUE_PRIVATE_METHOD) != 0) diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index db490fb..fe433e4 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -533,7 +533,8 @@ InfoObjectMethodsCmd( "private", "public", "unexported" }; enum Scopes { - SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED + SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED, + SCOPE_LOCALPRIVATE }; if (objc < 2) { @@ -587,6 +588,9 @@ InfoObjectMethodsCmd( case SCOPE_PUBLIC: flag = PUBLIC_METHOD; break; + case SCOPE_LOCALPRIVATE: + flag = PRIVATE_METHOD; + break; case SCOPE_UNEXPORTED: flag = 0; break; @@ -608,7 +612,7 @@ InfoObjectMethodsCmd( } } else if (oPtr->methodsPtr) { FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { - if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } @@ -1314,7 +1318,7 @@ InfoClassMethodsCmd( FOREACH_HASH_DECLS; FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { - if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { Tcl_ListObjAppendElement(NULL, resultObj, namePtr); } } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index e81bbf9..a43ab76 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -407,6 +407,7 @@ typedef struct CallContext { /* This is a private method only accessible * from other methods defined on this class * or instance. [TIP #500] */ +#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD) /* * Structure containing definition information about basic class methods. diff --git a/tests/oo.test b/tests/oo.test index 9aedaaf..9563b4f 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -4691,6 +4691,42 @@ test oo-39.11 {TIP 500: private methods; call chain caching and reporting} -setu } -cleanup { parent destroy } -result {{{{method chain ::cls method}} 0} {{{method chain ::cls method}} 0} {{{private chain ::cls2 method} {method chain ::cls method}} 1} {{{private chain ::cls2 method} {method chain ::cls method}} 1}} +test oo-39.12 {TIP 500: private methods; introspection} -setup { + oo::class create parent +} -body { + oo::class create cls { + superclass parent + method chain {} { + return [self call] + } + private method abc {} {} + } + oo::class create cls2 { + superclass cls + method chain2 {} { + my chain + } + method chain3 {} { + [self] chain + } + private method def {} {} + unexport chain3 + } + cls create a + cls2 create b + oo::objdefine b { + private method ghi {} {} + method ABC {} {} + method foo {} {} + } + set scopes {public unexported private} + list a: [lmap s $scopes {info object methods a -scope $s}] \ + b: [lmap s $scopes {info object methods b -scope $s}] \ + cls: [lmap s $scopes {info class methods cls -scope $s}] \ + cls2: [lmap s $scopes {info class methods cls2 -scope $s}] \ +} -cleanup { + parent destroy +} -result {a: {{} {} {}} b: {foo ABC ghi} cls: {chain {} abc} cls2: {chain2 chain3 def}} cleanupTests return |