From 813979693c1e419effe81ceaa6fea3211ad6e0fa Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 27 May 2018 12:04:39 +0000
Subject: Add sensible behaviour with export and unexport of private methods.

---
 generic/tclOODefineCmds.c | 12 +++++++++---
 tests/oo.test             | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 3 deletions(-)

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 7281d7a..19cd42b 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -125,6 +125,11 @@ static const struct DeclaredSlot slots[] = {
     {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
 };
 
+/*
+ * How to build the in-namespace name of a private variable. This is a pattern
+ * used with Tcl_ObjPrintf().
+ */
+
 #define PRIVATE_VARIABLE_PATTERN "%d : %s"
 
 /*
@@ -1687,8 +1692,9 @@ TclOODefineExportObjCmd(
 	} else {
 	    mPtr = Tcl_GetHashValue(hPtr);
 	}
-	if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
+	if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
 	    mPtr->flags |= PUBLIC_METHOD;
+	    mPtr->flags &= ~TRUE_PRIVATE_METHOD;
 	    changed = 1;
 	}
     }
@@ -2028,8 +2034,8 @@ TclOODefineUnexportObjCmd(
 	} else {
 	    mPtr = Tcl_GetHashValue(hPtr);
 	}
-	if (isNew || mPtr->flags & PUBLIC_METHOD) {
-	    mPtr->flags &= ~PUBLIC_METHOD;
+	if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
+	    mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
 	    changed = 1;
 	}
     }
diff --git a/tests/oo.test b/tests/oo.test
index 24f23ae..9a22438 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -4813,6 +4813,38 @@ test oo-40.1 {TIP 500: private and self} -setup {
 } -cleanup {
     cls destroy
 } -result {e d b {a c}}
+test oo-40.2 {TIP 500: private and export} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {
+	private method foo {} {}
+    }
+    set result [lmap s {public unexported private} {
+	info class methods cls -scope $s}]
+    oo::define cls {
+	export foo
+    }
+    lappend result {*}[lmap s {public unexported private} {
+	info class methods cls -scope $s}]
+} -cleanup {
+    cls destroy
+} -result {{} {} foo foo {} {}}
+test oo-40.3 {TIP 500: private and unexport} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {
+	private method foo {} {}
+    }
+    set result [lmap s {public unexported private} {
+	info class methods cls -scope $s}]
+    oo::define cls {
+	unexport foo
+    }
+    lappend result {*}[lmap s {public unexported private} {
+	info class methods cls -scope $s}]
+} -cleanup {
+    cls destroy
+} -result {{} {} foo {} foo {}}
 
 cleanupTests
 return
-- 
cgit v0.12