From 1eeefb073a3dec57e47e1b30b8df7467358857e7 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 25 Feb 2020 15:07:51 +0000
Subject: Ensure that we release the correct references when an error occurs
 during setting a class's superclasses

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

diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index f02e1d3..2ace60c 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -2132,7 +2132,6 @@ ClassSuperSet(
 	    superclasses[i] = GetClassInOuterContext(interp, superv[i],
 		    "only a class can be a superclass");
 	    if (superclasses[i] == NULL) {
-		i--;
 		goto failedAfterAlloc;
 	    }
 	    for (j = 0; j < i; j++) {
@@ -2149,7 +2148,7 @@ ClassSuperSet(
 			"attempt to form circular dependency graph", -1));
 		Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
 	    failedAfterAlloc:
-		for (; i > 0; i--) {
+		for (; i-- > 0 ;) {
 		    TclOODecrRefCount(superclasses[i]->thisPtr);
 		}
 		ckfree(superclasses);
diff --git a/tests/oo.test b/tests/oo.test
index 065c017..e917bc9 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -314,7 +314,41 @@ test oo-1.18.3 {Bug 21c144f0f5} -setup {
     }
 } -cleanup {
     interp delete slave
-} 
+}
+test oo-1.18.4 {correct handling of cleanup in superclass set error} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	oo::class create A
+	oo::class create B {
+	    superclass oo::class
+	    constructor {} {
+		next {superclass A}
+		next {superclass -append A}
+	    }
+	}
+	[B create C] create d
+    }
+} -returnCodes error -cleanup {
+    interp delete slave
+} -result {class should only be a direct superclass once}
+test oo-1.18.5 {correct handling of cleanup in superclass set error} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	oo::class create A
+	oo::class create B {
+	    superclass oo::class
+	    constructor {c} {
+		next {superclass A}
+		next [list superclass -append {*}$c]
+	    }
+	}
+	[B create C {B C}] create d
+    }
+} -returnCodes error -cleanup {
+    interp delete slave
+} -result {attempt to form circular dependency graph}
 test oo-1.19 {basic test of OO functionality: teardown order} -body {
     oo::object create o
     namespace delete [info object namespace o]
-- 
cgit v0.12