merge trunk

3 files changed, 64 insertions, 42 deletions

diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 2c2397f..65147d4 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -1248,6 +1248,7 @@ fixempties(
 {
     struct state *s;
     struct state *nexts;
+    struct state *to;
     struct arc *a;
     struct arc *nexta;
     int progress;
@@ -1258,15 +1259,50 @@ fixempties(
 
     do {
 	progress = 0;
-	for (s = nfa->states; s != NULL && !NISERR()
-		&& s->no != FREESTATE; s = nexts) {
+	for (s = nfa->states; s != NULL && !NISERR(); s = nexts) {
 	    nexts = s->next;
-	    for (a = s->outs; a != NULL && !NISERR(); a = nexta) {
+	    for (a = s->outs; a != NULL && !NISERR(); a = a->outchain) {
+		if (a->type == EMPTY) {
+
+		    /*
+		     *  Mark a for deletion; copy arcs to preserve graph
+		     * connectivity after it is gone.
+		     */
+
+		    unempty(nfa, a);
+		}
+	    }
+
+	    /*
+	     * Now pass through and delete the marked arcs.  Doing all the
+	     * deletion after all the marking prevents arc copying from
+	     * resurrecting deleted arcs which can cause failure to converge.
+	     * [Tcl Bug 3604074]
+	     */
+
+	    for (a = s->outs; a != NULL; a = nexta) {
 		nexta = a->outchain;
-		if (a->type == EMPTY && unempty(nfa, a)) {
+		if (a->from == NULL) {
 		    progress = 1;
+		    to = a->to;
+		    a->from = s;
+		    freearc(nfa, a);
+		    if (to->nins == 0) {
+			while ((a = to->outs)) {
+			    freearc(nfa, a);
+			}
+			if (nexts == to) {
+			    nexts = to->next;
+			}
+			freestate(nfa, to);
+		    }
+		    if (s->nouts == 0) {
+			while ((a = s->ins)) {
+			    freearc(nfa, a);
+			}
+			freestate(nfa, s);
+		    }
 		}
-		assert(nexta == NULL || s->no != FREESTATE);
 	    }
 	}
 	if (progress && f != NULL) {
@@ -1288,7 +1324,6 @@ unempty(
 {
     struct state *from = a->from;
     struct state *to = a->to;
-    int usefrom;		/* work on from, as opposed to to? */
 
     assert(a->type == EMPTY);
     assert(from != nfa->pre && to != nfa->post);
@@ -1299,47 +1334,30 @@ unempty(
     }
 
     /*
-     * Decide which end to work on.
+     *  Mark arc for deletion.
      */
 
-    usefrom = 1;		/* default: attack from */
+    a->from = NULL;
+
     if (from->nouts > to->nins) {
-	usefrom = 0;
-    } else if (from->nouts == to->nins) {
-	/*
-	 * Decide on secondary issue: move/copy fewest arcs.
-	 */
-
-	if (from->nins > to->nouts) {
-	    usefrom = 0;
-	}
+	copyouts(nfa, to, from);
+	return 1;
+    }
+    if (from->nouts < to->nins) {
+	copyins(nfa, from, to);
+	return 1;
     }
 
-    freearc(nfa, a);
-    if (usefrom) {
-	if (from->nouts == 0) {
-	    /*
-	     * Was the state's only outarc.
-	     */
-
-	    moveins(nfa, from, to);
-	    freestate(nfa, from);
-	} else {
-	    copyins(nfa, from, to);
-	}
-    } else {
-	if (to->nins == 0) {
-	    /*
-	     * Was the state's only inarc.
-	     */
+    /*
+     * from->nouts == to->nins . decide on secondary issue:  copy fewest arcs
+     */
 
-	    moveouts(nfa, to, from);
-	    freestate(nfa, to);
-	} else {
-	    copyouts(nfa, to, from);
-	}
+    if (from->nins > to->nouts) {
+	copyouts(nfa, to, from);
+	return 1;
     }
 
+    copyins(nfa, from, to);
     return 1;
 }
 
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 4069cf0..dde116f 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -4559,7 +4559,11 @@ TclGetInnerContext(
         if (!objPtr) {
             Tcl_Panic("InnerContext: bad tos -- appending null object");
         }
-        if (objPtr->refCount<=0 || objPtr->refCount==0x61616161) {
+        if ((objPtr->refCount<=0)
+#ifdef TCL_MEM_DEBUG
+                || (objPtr->refCount==0x61616161)
+#endif
+        ) {
             Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
                     objPtr);
         }
diff --git a/generic/tclLoadNone.c b/generic/tclLoadNone.c
index 5a2dc53..c22c4c4 100644
--- a/generic/tclLoadNone.c
+++ b/generic/tclLoadNone.c
@@ -107,8 +107,8 @@ TclpLoadMemory(
     Tcl_FSUnloadFileProc **unloadProcPtr)
 				/* Dummy: unused by this implementation */
 {
-    Tcl_SetResult(interp, "dynamic loading from memory is not available "
-	    "on this system", TCL_STATIC);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj("dynamic loading from memory "
+	    "is not available on this system", -1));
     return TCL_ERROR;
 }