summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-21 23:58:03 (GMT)
committerhobbs <hobbs>1999-12-21 23:58:03 (GMT)
commitbdf52c7793a08e6f394c1156dbfffdcde3daf2b8 (patch)
tree0b6676817dda931edd6b013531b493b34a2c5b22 /generic
parentad4a42c1c2da6828324db8589acddcca79616e8c (diff)
downloadtcl-bdf52c7793a08e6f394c1156dbfffdcde3daf2b8.zip
tcl-bdf52c7793a08e6f394c1156dbfffdcde3daf2b8.tar.gz
tcl-bdf52c7793a08e6f394c1156dbfffdcde3daf2b8.tar.bz2
* generic/tclCmdIL.c: added -unique option to lsort
* generic/tclThreadTest.c: changed thread ids to longs [Bug: 3902]
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclCmdIL.c44
-rw-r--r--generic/tclIO.c6
-rw-r--r--generic/tclThreadTest.c12
4 files changed, 47 insertions, 21 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index f200531..bc56bb6 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.59 1999/10/13 00:32:16 hobbs Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.60 1999/12/21 23:58:03 hobbs Exp $
*/
#ifndef _TCL
@@ -55,11 +55,11 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 3
-#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
+#define TCL_RELEASE_LEVEL TCL_BETA_RELEASE
#define TCL_RELEASE_SERIAL 1
#define TCL_VERSION "8.3"
-#define TCL_PATCH_LEVEL "8.3a1"
+#define TCL_PATCH_LEVEL "8.3b1"
/*
* The following definitions set up the proper options for Windows
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 01c5a25..6e7e908 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.18 1999/11/24 20:55:07 hobbs Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.19 1999/12/21 23:58:03 hobbs Exp $
*/
#include "tclInt.h"
@@ -30,6 +30,7 @@
typedef struct SortElement {
Tcl_Obj *objPtr; /* Object being sorted. */
+ int count; /* number of same elements in list */
struct SortElement *nextPtr; /* Next element in the list, or
* NULL for end of list. */
} SortElement;
@@ -2428,7 +2429,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument values. */
{
- int i, index;
+ int i, index, unique;
Tcl_Obj *resultPtr;
int length;
Tcl_Obj *cmdPtr, **listObjPtrs;
@@ -2437,9 +2438,10 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
SortInfo sortInfo; /* Information about this sort that
* needs to be passed to the
* comparison function */
- static char *switches[] =
- {"-ascii", "-command", "-decreasing", "-dictionary",
- "-increasing", "-index", "-integer", "-real", (char *) NULL};
+ static char *switches[] = {
+ "-ascii", "-command", "-decreasing", "-dictionary", "-increasing",
+ "-index", "-integer", "-real", "-unique", (char *) NULL
+ };
resultPtr = Tcl_GetObjResult(interp);
if (objc < 2) {
@@ -2457,6 +2459,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
sortInfo.interp = interp;
sortInfo.resultCode = TCL_OK;
cmdPtr = NULL;
+ unique = 0;
for (i = 1; i < objc-1; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], switches, "option", 0, &index)
!= TCL_OK) {
@@ -2506,6 +2509,9 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
case 7: /* -real */
sortInfo.sortMode = SORTMODE_REAL;
break;
+ case 8: /* -unique */
+ unique = 1;
+ break;
}
}
if (sortInfo.sortMode == SORTMODE_COMMAND) {
@@ -2537,6 +2543,7 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
elementArray = (SortElement *) ckalloc(length * sizeof(SortElement));
for (i=0; i < length; i++){
elementArray[i].objPtr = listObjPtrs[i];
+ elementArray[i].count = 0;
elementArray[i].nextPtr = &elementArray[i+1];
}
elementArray[length-1].nextPtr = NULL;
@@ -2549,8 +2556,18 @@ Tcl_LsortObjCmd(clientData, interp, objc, objv)
Tcl_ResetResult(interp);
resultPtr = Tcl_GetObjResult(interp);
- for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
- Tcl_ListObjAppendElement(interp, resultPtr, elementPtr->objPtr);
+ if (unique) {
+ for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+ if (elementPtr->count == 0) {
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ elementPtr->objPtr);
+ }
+ }
+ } else {
+ for (; elementPtr != NULL; elementPtr = elementPtr->nextPtr){
+ Tcl_ListObjAppendElement(interp, resultPtr,
+ elementPtr->objPtr);
+ }
}
}
ckfree((char*) elementArray);
@@ -2650,6 +2667,7 @@ MergeLists(leftPtr, rightPtr, infoPtr)
{
SortElement *headPtr;
SortElement *tailPtr;
+ int cmp;
if (leftPtr == NULL) {
return rightPtr;
@@ -2657,20 +2675,28 @@ MergeLists(leftPtr, rightPtr, infoPtr)
if (rightPtr == NULL) {
return leftPtr;
}
- if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+ cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ if (cmp > 0) {
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
+ if (cmp == 0) {
+ leftPtr->count++;
+ }
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
}
headPtr = tailPtr;
while ((leftPtr != NULL) && (rightPtr != NULL)) {
- if (SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr) > 0) {
+ cmp = SortCompare(leftPtr->objPtr, rightPtr->objPtr, infoPtr);
+ if (cmp > 0) {
tailPtr->nextPtr = rightPtr;
tailPtr = rightPtr;
rightPtr = rightPtr->nextPtr;
} else {
+ if (cmp == 0) {
+ leftPtr->count++;
+ }
tailPtr->nextPtr = leftPtr;
tailPtr = leftPtr;
leftPtr = leftPtr->nextPtr;
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 7ef54fb..117acaa 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIO.c,v 1.18 1999/12/08 03:49:52 hobbs Exp $
+ * RCS: @(#) $Id: tclIO.c,v 1.19 1999/12/21 23:58:03 hobbs Exp $
*/
#include "tclInt.h"
@@ -2324,8 +2324,8 @@ FlushChannel(interp, chanPtr, calledFromAsyncFlush)
/*
* This used to check for CHANNEL_NONBLOCKING, and panic
* if the channel was blocking. However, it appears
- * that setting stdin to -blocking 0 has some effect
- * on the stdout when it's a tty channel
+ * that setting stdin to -blocking 0 has some effect on
+ * the stdout when it's a tty channel (dup'ed underneath)
*/
if (!(chanPtr->flags & BG_FLUSH_SCHEDULED)) {
chanPtr->flags |= BG_FLUSH_SCHEDULED;
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 113f327..60ea7a9 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclThreadTest.c,v 1.4 1999/10/21 02:16:22 hobbs Exp $
+ * RCS: @(#) $Id: tclThreadTest.c,v 1.5 1999/12/21 23:58:04 hobbs Exp $
*/
#include "tclInt.h"
@@ -256,7 +256,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
}
case THREAD_ID:
if (objc == 2) {
- Tcl_Obj *idObj = Tcl_NewIntObj((int)Tcl_GetCurrentThread());
+ Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
@@ -271,7 +271,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
return TclThreadList(interp);
}
case THREAD_SEND: {
- int id;
+ long id;
char *script;
int wait, arg;
@@ -290,7 +290,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv)
wait = 1;
arg = 2;
}
- if (Tcl_GetIntFromObj(interp, objv[arg], &id) != TCL_OK) {
+ if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
@@ -373,7 +373,7 @@ TclCreateThread(interp, script)
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
TclFinalizeCondition(&ctrl.condWait);
- Tcl_SetObjResult(interp, Tcl_NewIntObj((int)id));
+ Tcl_SetObjResult(interp, Tcl_NewLongObj((long)id));
return TCL_OK;
}
@@ -610,7 +610,7 @@ TclThreadList(interp)
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
- Tcl_NewIntObj((int)tsdPtr->threadId));
+ Tcl_NewLongObj((long)tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);