summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorsebres <sebres@users.sourceforge.net>2019-05-21 11:46:36 (GMT)
committersebres <sebres@users.sourceforge.net>2019-05-21 11:46:36 (GMT)
commitfd3264c3a0c9375dcf5d5753e1b2b9d00bfc7eaf (patch)
tree4b5c0408409b30bef0cfc69da163e59f1ebfc276
parentd2867d11a44aff32721a7daaef8aa4382843f2be (diff)
parente94891207a103ee730e59b6e3111fe1ff9528507 (diff)
downloadtcl-fd3264c3a0c9375dcf5d5753e1b2b9d00bfc7eaf.zip
tcl-fd3264c3a0c9375dcf5d5753e1b2b9d00bfc7eaf.tar.gz
tcl-fd3264c3a0c9375dcf5d5753e1b2b9d00bfc7eaf.tar.bz2
merge 8.7
-rw-r--r--generic/tclCmdMZ.c47
-rw-r--r--generic/tclHash.c5
-rw-r--r--generic/tclTest.c2
-rw-r--r--tests/cmdMZ.test14
4 files changed, 51 insertions, 17 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 7a4acdc..5f49e15 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -4199,6 +4199,7 @@ Tcl_TimeRateObjCmd(
};
NRE_callback *rootPtr;
ByteCode *codePtr = NULL;
+ int codeOptimized = 0;
for (i = 1; i < objc - 1; i++) {
int index;
@@ -4383,6 +4384,15 @@ Tcl_TimeRateObjCmd(
}
codePtr = TclCompileObj(interp, objPtr, NULL, 0);
TclPreserveByteCode(codePtr);
+ /*
+ * Replace last compiled done instruction with continue: it's a part of
+ * iteration, this way evaluation will be more similar to a cycle (also
+ * avoids extra overhead to set result to interp, etc.)
+ */
+ if (codePtr->codeStart[codePtr->numCodeBytes-1] == INST_DONE) {
+ codePtr->codeStart[codePtr->numCodeBytes-1] = INST_CONTINUE;
+ codeOptimized = 1;
+ }
}
/*
@@ -4429,23 +4439,25 @@ Tcl_TimeRateObjCmd(
} else { /* eval */
result = TclEvalObjEx(interp, objPtr, 0, NULL, 0);
}
- if (result != TCL_OK) {
- /*
- * Allow break from measurement cycle (used for conditional
- * stop).
- */
+ /*
+ * Allow break and continue from measurement cycle (used for
+ * conditional stop and flow control of iterations).
+ */
- if (result != TCL_BREAK) {
+ switch (result) {
+ case TCL_OK:
+ break;
+ case TCL_BREAK:
+ /*
+ * Force stop immediately.
+ */
+ threshold = 1;
+ maxcnt = 0;
+ case TCL_CONTINUE:
+ result = TCL_OK;
+ break;
+ default:
goto done;
- }
-
- /*
- * Force stop immediately.
- */
-
- threshold = 1;
- maxcnt = 0;
- result = TCL_OK;
}
/*
@@ -4671,6 +4683,11 @@ Tcl_TimeRateObjCmd(
done:
if (codePtr != NULL) {
+ if ( codeOptimized
+ && codePtr->codeStart[codePtr->numCodeBytes-1] == INST_CONTINUE
+ ) {
+ codePtr->codeStart[codePtr->numCodeBytes-1] = INST_DONE;
+ }
TclReleaseByteCode(codePtr);
}
return result;
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 2ab4292..7357f32 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -284,7 +284,10 @@ CreateHashEntry(
if (hash != hPtr->hash) {
continue;
}
- if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
+ /* if keys pointers or values are equal */
+ if ((key == hPtr->key.oneWordValue)
+ || compareKeysProc((VOID *) key, hPtr)
+ ) {
if (newPtr) {
*newPtr = 0;
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 049a81c..450d663 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -4419,7 +4419,7 @@ TesttranslatefilenameCmd(
*
* TestupvarCmd --
*
- * This procedure implements the "testupvar2" command. It is used
+ * This procedure implements the "testupvar" command. It is used
* to test Tcl_UpVar and Tcl_UpVar2.
*
* Results:
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 2c2d51c..60cc621 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -403,6 +403,14 @@ test cmdMZ-6.8 {Tcl_TimeRateObjCmd: allow (conditional) break from timerate} {
[expr {[lindex $m1 4] > 1000}] \
[expr {[lindex $m1 6] < 10}]
} {1 1 1 1}
+test cmdMZ-6.8.1 {Tcl_TimeRateObjCmd: allow (conditional) continue in timerate} {
+ set m1 [timerate {continue; return -code error "unexpected"} 1000 10]
+ list \
+ [expr {[lindex $m1 0] < 1000}] \
+ [expr {[lindex $m1 2] == 10}] \
+ [expr {[lindex $m1 4] > 1000}] \
+ [expr {[lindex $m1 6] < 100}]
+} {1 1 1 1}
test cmdMZ-6.9 {Tcl_TimeRateObjCmd: max count of iterations} {
set m1 [timerate {} 1000 5]; # max-count wins
set m2 [timerate {_nrt_sleep 20} 1 5]; # max-time wins
@@ -416,6 +424,12 @@ test cmdMZ-6.10 {Tcl_TimeRateObjCmd: huge overhead cause 0us result} {
[expr {[lindex $m1 4] == 1000000}] \
[expr {[lindex $m1 6] <= 0.001}]
} {1 1 1 1}
+test cmdMZ-6.11 {Tcl_TimeRateObjCmd: done/continue optimization rollback} {
+ set m1 {set m2 ok}
+ if 1 $m1
+ timerate $m1 1000 10
+ if 1 $m1; # if rollback is missing throws an error: invoked "continue" outside of a loop
+} ok
test cmdMZ-try-1.0 {