diff options
43 files changed, 3622 insertions, 992 deletions
diff --git a/compat/zlib/contrib/minizip/tinydir.h b/compat/zlib/contrib/minizip/tinydir.h index ba20c3e..b8133ac 100644 --- a/compat/zlib/contrib/minizip/tinydir.h +++ b/compat/zlib/contrib/minizip/tinydir.h @@ -546,12 +546,6 @@ int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file) #ifndef _MSC_VER #ifdef __MINGW32__ if (_tstat( -#elif (defined _BSD_SOURCE) || (defined _DEFAULT_SOURCE) \ - || ((defined _XOPEN_SOURCE) && (_XOPEN_SOURCE >= 500)) \ - || ((defined _POSIX_C_SOURCE) && (_POSIX_C_SOURCE >= 200112L)) \ - || ((defined __APPLE__) && (defined __MACH__)) \ - || (defined BSD) - if (lstat( #else if (stat( #endif diff --git a/doc/CrtAlias.3 b/doc/CrtAlias.3 index 55cc933..12494bf 100644 --- a/doc/CrtAlias.3 +++ b/doc/CrtAlias.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands +Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAlias, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands .SH SYNOPSIS .nf \fB#include <tcl.h>\fR @@ -16,9 +16,6 @@ Tcl_IsSafe, Tcl_MakeSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetI int \fBTcl_IsSafe\fR(\fIinterp\fR) .sp -int -\fBTcl_MakeSafe\fR(\fIinterp\fR) -.sp Tcl_Interp * \fBTcl_CreateChild\fR(\fIinterp, name, isSafe\fR) .sp @@ -138,18 +135,6 @@ If the creation of the new child interpreter failed, \fBNULL\fR is returned. (was created with the \fBTCL_SAFE_INTERPRETER\fR flag specified), \fB0\fR otherwise. .PP -\fBTcl_MakeSafe\fR marks \fIinterp\fR as -.QW safe , -so that future -calls to \fBTcl_IsSafe\fR will return 1. It also removes all known -potentially-unsafe core functionality (both commands and variables) -from \fIinterp\fR. However, it cannot know what parts of an extension -or application are safe and does not make any attempt to remove those -parts, so safety is not guaranteed after calling \fBTcl_MakeSafe\fR. -Callers will want to take care with their use of \fBTcl_MakeSafe\fR -to avoid false claims of safety. For many situations, \fBTcl_CreateChild\fR -may be a better choice, since it creates interpreters in a known-safe state. -.PP \fBTcl_GetChild\fR returns a pointer to a child interpreter of \fIinterp\fR. The child interpreter is identified by \fIname\fR. If no such child interpreter exists, \fBNULL\fR is returned. diff --git a/doc/CrtChannel.3 b/doc/CrtChannel.3 index e84c29a..f04fbff 100644 --- a/doc/CrtChannel.3 +++ b/doc/CrtChannel.3 @@ -35,6 +35,11 @@ Tcl_ThreadId int \fBTcl_GetChannelMode\fR(\fIchannel\fR) .sp +.VS 8.7 +int +\fBTcl_RemoveChannelMode\fR(\fIinterp, channel, mode\fR) +.VE 8.7 +.sp int \fBTcl_GetChannelBufferSize\fR(\fIchannel\fR) .sp @@ -237,6 +242,16 @@ events to the correct event queue even for a multi-threaded core. and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input and output. .PP +.VS 8.7 +.PP +\fBTcl_RemoveChannelMode\fR removes an access privilege from the +channel, either \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR, and returns +a regular Tcl result code, \fBTCL_OK\fR, or \fBTCL_ERROR\fR. The +function throws an error if either an invalid mode is specified or the +result of the removal would be an inaccessible channel. In that case +an error message is left in the interp argument, if not NULL. +.VE 8.7 +.PP \fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers allocated to store input or output in \fIchannel\fR. If the value was not set by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then diff --git a/doc/StringObj.3 b/doc/StringObj.3 index 14041c5..2d41018 100644 --- a/doc/StringObj.3 +++ b/doc/StringObj.3 @@ -210,10 +210,12 @@ value's Unicode representation. If the index is out of range or it references a low surrogate preceded by a high surrogate, it returns -1; .PP \fBTcl_GetRange\fR returns a newly created value comprised of the -characters between \fIfirst\fR and \fIlast\fR (inclusive) in the -value's Unicode representation. If the value's Unicode -representation is invalid, the Unicode representation is regenerated -from the value's string representation. +characters between \fIfirst\fR and \fIlast\fR (inclusive) in the value's +Unicode representation. If the value's Unicode representation +is invalid, the Unicode representation is regenerated from the value's +string representation. If \fIfirst\fR == TCL_INDEX_NONE, then the returned +string starts at the beginning of the value. If \fIlast\fR == TCL_INDEX_NONE, +then the returned string ends at the end of the value. .PP \fBTcl_GetCharLength\fR returns the number of characters (as opposed to bytes) in the string value. @@ -252,14 +252,14 @@ symbolic and hard links (the latter for files only). Windows supports symbolic directory links and hard file links on NTFS drives. .RE .TP -\fBfile lstat \fIname varName\fR +\fBfile lstat \fIname ?varName?\fR . Same as \fBstat\fR option (see below) except uses the \fIlstat\fR kernel call instead of \fIstat\fR. This means that if \fIname\fR -refers to a symbolic link the information returned in \fIvarName\fR -is for the link rather than the file it refers to. On systems that -do not support symbolic links this option behaves exactly the same -as the \fBstat\fR option. +refers to a symbolic link the information returned is for the link +rather than the file it refers to. On systems that do not support +symbolic links this option behaves exactly the same as the +\fBstat\fR option. .TP \fBfile mkdir\fR ?\fIdir\fR ...? . @@ -381,19 +381,20 @@ first element of the list will have the same path type as \fIname\fR. All other elements will be relative. Path separators will be discarded unless they are needed to ensure that an element is unambiguously relative. .TP -\fBfile stat \fIname varName\fR -. -Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable -given by \fIvarName\fR to hold information returned from the kernel call. -\fIVarName\fR is treated as an array variable, and the following elements -of that variable are set: \fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR, -\fBino\fR, \fBmode\fR, \fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR, -\fBuid\fR. Each element except \fBtype\fR is a decimal string with the -value of the corresponding field from the \fBstat\fR return structure; -see the manual entry for \fBstat\fR for details on the meanings of the -values. The \fBtype\fR element gives the type of the file in the same -form returned by the command \fBfile type\fR. This command returns an -empty string. +\fBfile stat \fIname ?varName?\fR +. +Invokes the \fBstat\fR kernel call on \fIname\fR, and returns a +dictionary with the information returned from the kernel call. If +\fIvarName\fR is given, it uses the variable to hold the information. +\fIVarName\fR is treated as an array variable, and in such case the +command returns the empty string. The following elements are set: +\fBatime\fR, \fBctime\fR, \fBdev\fR, \fBgid\fR, \fBino\fR, \fBmode\fR, +\fBmtime\fR, \fBnlink\fR, \fBsize\fR, \fBtype\fR, \fBuid\fR. Each element +except \fBtype\fR is a decimal string with the value of the corresponding +field from the \fBstat\fR return structure; see the manual entry for +\fBstat\fR for details on the meanings of the values. The \fBtype\fR +element gives the type of the file in the same form returned by the +command \fBfile type\fR. .TP \fBfile system \fIname\fR . diff --git a/doc/lseq.n b/doc/lseq.n new file mode 100644 index 0000000..5c7d03b --- /dev/null +++ b/doc/lseq.n @@ -0,0 +1,92 @@ +'\" +'\" Copyright (c) 2022 Eric Taylor. All rights reserved. +'\" +'\" See the file "license.terms" for information on usage and redistribution +'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. +'\" +.TH lseq n 8.7 Tcl "Tcl Built-In Commands" +.so man.macros +.BS +'\" Note: do not modify the .SH NAME line immediately below! +.SH NAME +lseq \- Build a numeric sequence returned as a list +.SH SYNOPSIS +\fBlseq \fIStart \fR?(\fB..\fR|\fBto\fR)? \fIEnd\fR ??\fBby\fR? \fIStep\fR? + +\fBlseq \fIStart \fBcount\fR \fICount\fR ??\fBby\fR? \fIStep\fR? + +\fBlseq \fICount\fR ?\fBby \fIStep\fR? +.BE +.SH DESCRIPTION +.PP +The \fBlseq\fR command creates a sequence of numeric values using the given +parameters \fIStart\fR, \fIEnd\fR, and \fIStep\fR. The \fIoperation\fR +argument ".." or "to" defines an inclusive range. The "count" option is used +to define a count of the number of elements in the list. The short form with a +single count value will create a range from 0 to count-1. + +The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR, +can also be a valid expression. the lseq command will evaluate the expression +and use the numeric result, or return an error as with any invalid argument +value. A valid expression is a valid [expr] expression, however, the result +must be numeric; a non-numeric string will result in an error. + +.SH EXAMPLES +.CS +.\" + + lseq 3 + \(-> 0 1 2 + + lseq 3 0 + \(-> 3 2 1 0 + + lseq 10 .. 1 by -2 + \(-> 10 8 6 4 2 + + set l [lseq 0 -5] + \(-> 0 -1 -2 -3 -4 -5 + + foreach i [lseq [llength $l]] { + puts l($i)=[lindex $l $i] + } + \(-> l(0)=0 + l(1)=-1 + l(2)=-2 + l(3)=-3 + l(4)=-4 + l(5)=-5 + + foreach i [lseq [llength $l]-1 0] { + puts l($i)=[lindex $l $i] + } + \(-> l(5)=-5 + l(4)=-4 + l(3)=-3 + l(2)=-2 + l(1)=-1 + l(0)=0 + + set i 17 + \(-> 17 + if {$i in [lseq 0 50]} { # equivalent to: (0 <= $i && $i < 50) + puts "Ok" + } else { + puts "outside :(" + } + \(-> Ok + + set sqrs [lmap i [lseq 1 10] {expr $i*$i}] + \(-> 1 4 9 16 25 36 49 64 81 100 +.\" +.CE +.SH "SEE ALSO" +foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n), +lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n), +lreverse(n), lsearch(n), lset(n), lsort(n) +.SH KEYWORDS +element, index, list +'\" Local Variables: +'\" mode: nroff +'\" fill-column: 78 +'\" End: diff --git a/doc/vwait.n b/doc/vwait.n index f64d39c..5f240d6 100644 --- a/doc/vwait.n +++ b/doc/vwait.n @@ -12,6 +12,8 @@ vwait \- Process events until a variable is written .SH SYNOPSIS \fBvwait\fR \fIvarName\fR +.PP +\fBvwait\fR ?\Ioptions\fR? ?\fIvarName ...\fR? .BE .SH DESCRIPTION .PP @@ -24,8 +26,75 @@ command will return as soon as the event handler that modified a variable name with respect to the global namespace, but can refer to any namespace's variables if the fully-qualified name is given. .PP +In the second more complex command form \fIoptions\fR allow for finer +control of the wait operation and to deal with multiple event sources. +\fIOptions\fR can be made up of +.TP +\fB\-\-\fR +. +Marks the end of options. All following arguments are handled as +variable names. +.TP +\fB\-all\fR +. +All conditions for the wait operation must be met to complete the +wait operation. Otherwise (the default) the first event completes +the wait. +.TP +\fB\-extended\fR +. +An extended result in list form is returned, see below for explanation. +.TP +\fB\-nofileevents\fR +. +File events are not handled in the wait operation. +.TP +\fB\-noidleevents\fR +. +Idle handlers are not invoked during the wait operation. +.TP +\fB\-notimerevents\fR +. +Timer handlers are not serviced during the wait operation. +.TP +\fB\-nowindowevents\fR +. +Events of the windowing system are not handled during the wait operation. +.TP +\fB\-readable\fR \fIchannel\fR +. +\fIChannel\fR must name a Tcl channel open for reading. If \fIchannel\fR +is or becomes readable the wait operation completes. +.TP +\fB\-timeout\fR milliseconds\fR +. +The wait operation is constrained to \fImilliseconds\fR. +.TP +\fB\-variable\fR \fIvarName\fR +. +\fIVarName\fR must be the name of a global variable. Writing or +unsetting this variable completes the wait operation. +.TP +\fB\-writable\fR \fIchannel\fR +. +\fIChannel\fR must name a Tcl channel open for writing. If \fIchannel\fR +is or becomes writable the wait operation completes. +.PP +The result returned by \fBvwait\fR is for the simple form an empty +string. If the \fI\-timeout\fR option is specified, the result is the +number of milliseconds remaining when the wait condition has been +met, or -1 if the wait operation timed out. +.PP +If the \fI\-extended\fR option is specified, the result is made up +of a Tcl list with an even number of elements. Odd elements +take the values \fBreadable\fR, \fBtimeleft\fR, \fBvariable\fR, +and \fBwritable\fR. Even elements are the corresponding variable +and channel names or the remaining number of milliseconds. +The list is ordered by the occurrences of the event(s) with the +exception of \fBtimeleft\fR which always comes last. +.PP In some cases the \fBvwait\fR command may not return immediately -after \fIvarName\fR is set. This happens if the event handler +after \fIvarName\fR et.al. is set. This happens if the event handler that sets \fIvarName\fR does not complete immediately. For example, if an event handler sets \fIvarName\fR and then itself calls \fBvwait\fR to wait for a different variable, then it may not return diff --git a/generic/tcl.decls b/generic/tcl.decls index 15025f7..6f24f38 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -702,9 +702,10 @@ declare 187 { declare 189 { Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode) } -declare 190 { - int Tcl_MakeSafe(Tcl_Interp *interp) -} +# Removed in 9.0 +#declare 190 { +# int Tcl_MakeSafe(Tcl_Interp *interp) +#} declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket) } @@ -2560,6 +2561,8 @@ declare 673 { int Tcl_GetUniChar(Tcl_Obj *objPtr, Tcl_Size index) } +# slot 674 and 675 are reserved for TIP #618 + declare 676 { Tcl_Command Tcl_CreateObjCommand2(Tcl_Interp *interp, const char *cmdName, @@ -2582,6 +2585,13 @@ declare 679 { void *clientData, size_t objc, Tcl_Obj *const objv[]) } +# slot 680 and 681 are reserved for TIP #638 + +# TIP #220. +declare 682 { + int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) +} + # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## diff --git a/generic/tclArithSeries.c b/generic/tclArithSeries.c new file mode 100755 index 0000000..97a0a64 --- /dev/null +++ b/generic/tclArithSeries.c @@ -0,0 +1,952 @@ +/* + * tclArithSeries.c -- + * + * This file contains the ArithSeries concrete abstract list + * implementation. It implements the inner workings of the lseq command. + * + * Copyright © 2022 Brian S. Griffin. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +#include "tclInt.h" +#include "tclArithSeries.h" +#include <assert.h> + +/* -------------------------- ArithSeries object ---------------------------- */ + + +#define ArithSeriesRepPtr(arithSeriesObjPtr) \ + (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1) + +#define ArithSeriesIndexM(arithSeriesRepPtr, index) \ + ((arithSeriesRepPtr)->isDouble ? \ + (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \ + : \ + ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step))) + +#define ArithSeriesGetInternalRep(objPtr, arithRepPtr) \ + do { \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType); \ + (arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL; \ + } while (0) + + +/* + * Prototypes for procedures defined later in this file: + */ + +static void DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); +static void FreeArithSeriesInternalRep (Tcl_Obj *listPtr); +static int SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); +static void UpdateStringOfArithSeries (Tcl_Obj *listPtr); + +/* + * The structure below defines the arithmetic series Tcl object type by + * means of procedures that can be invoked by generic object code. + * + * The arithmetic series object is a special case of Tcl list representing + * an interval of an arithmetic series in constant space. + * + * The arithmetic series is internally represented with three integers, + * *start*, *end*, and *step*, Where the length is calculated with + * the following algorithm: + * + * if RANGE == 0 THEN + * ERROR + * if RANGE > 0 + * LEN is (((END-START)-1)/STEP) + 1 + * else if RANGE < 0 + * LEN is (((END-START)-1)/STEP) - 1 + * + * And where the equivalent's list I-th element is calculated + * as: + * + * LIST[i] = START+(STEP*i) + * + * Zero elements ranges, like in the case of START=10 END=10 STEP=1 + * are valid and will be equivalent to the empty list. + */ + +const Tcl_ObjType tclArithSeriesType = { + "arithseries", /* name */ + FreeArithSeriesInternalRep, /* freeIntRepProc */ + DupArithSeriesInternalRep, /* dupIntRepProc */ + UpdateStringOfArithSeries, /* updateStringProc */ + SetArithSeriesFromAny /* setFromAnyProc */ +}; + +/* + *---------------------------------------------------------------------- + * + * ArithSeriesLen -- + * + * Compute the length of the equivalent list where + * every element is generated starting from *start*, + * and adding *step* to generate every successive element + * that's < *end* for positive steps, or > *end* for negative + * steps. + * + * Results: + * + * The length of the list generated by the given range, + * that may be zero. + * The function returns -1 if the list is of length infinite. + * + * Side effects: + * + * None. + * + *---------------------------------------------------------------------- + */ +static Tcl_WideInt +ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step) +{ + Tcl_WideInt len; + + if (step == 0) return 0; + len = (step ? (1 + (((end-start))/step)) : 0); + return (len < 0) ? -1 : len; +} + +/* + *---------------------------------------------------------------------- + * + * TclNewArithSeriesInt -- + * + * Creates a new ArithSeries object. The returned object has + * refcount = 0. + * + * Results: + * + * A Tcl_Obj pointer to the created ArithSeries object. + * A NULL pointer of the range is invalid. + * + * Side Effects: + * + * None. + *---------------------------------------------------------------------- + */ +Tcl_Obj * +TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len) +{ + Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_Obj *arithSeriesPtr; + ArithSeries *arithSeriesRepPtr; + + TclNewObj(arithSeriesPtr); + + if (length <= 0) { + return arithSeriesPtr; + } + + arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries)); + arithSeriesRepPtr->isDouble = 0; + arithSeriesRepPtr->start = start; + arithSeriesRepPtr->end = end; + arithSeriesRepPtr->step = step; + arithSeriesRepPtr->len = length; + arithSeriesRepPtr->elements = NULL; + arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; + arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL; + arithSeriesPtr->typePtr = &tclArithSeriesType; + if (length > 0) + Tcl_InvalidateStringRep(arithSeriesPtr); + + return arithSeriesPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclNewArithSeriesDbl -- + * + * Creates a new ArithSeries object with doubles. The returned object has + * refcount = 0. + * + * Results: + * + * A Tcl_Obj pointer to the created ArithSeries object. + * A NULL pointer of the range is invalid. + * + * Side Effects: + * + * None. + *---------------------------------------------------------------------- + */ +Tcl_Obj * +TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) +{ + Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); + Tcl_Obj *arithSeriesPtr; + ArithSeriesDbl *arithSeriesRepPtr; + + TclNewObj(arithSeriesPtr); + + if (length <= 0) { + return arithSeriesPtr; + } + + arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl)); + arithSeriesRepPtr->isDouble = 1; + arithSeriesRepPtr->start = start; + arithSeriesRepPtr->end = end; + arithSeriesRepPtr->step = step; + arithSeriesRepPtr->len = length; + arithSeriesRepPtr->elements = NULL; + arithSeriesPtr->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr; + arithSeriesPtr->internalRep.twoPtrValue.ptr2 = NULL; + arithSeriesPtr->typePtr = &tclArithSeriesType; + if (length > 0) + Tcl_InvalidateStringRep(arithSeriesPtr); + + return arithSeriesPtr; +} + +/* + *---------------------------------------------------------------------- + * + * assignNumber -- + * + * Create the appropriate Tcl_Obj value for the given numeric values. + * Used locally only for decoding [lseq] numeric arguments. + * refcount = 0. + * + * Results: + * + * A Tcl_Obj pointer. + * No assignment on error. + * + * Side Effects: + * + * None. + *---------------------------------------------------------------------- + */ +static void +assignNumber(int useDoubles, Tcl_WideInt *intNumberPtr, double *dblNumberPtr, Tcl_Obj *numberObj) +{ + union { + double d; + Tcl_WideInt i; + } *number; + int tcl_number_type; + + if (TclGetNumberFromObj(NULL, numberObj, (ClientData*)&number, &tcl_number_type) != TCL_OK) { + return; + } + if (useDoubles) { + if (tcl_number_type == TCL_NUMBER_DOUBLE) { + *dblNumberPtr = number->d; + } else { + *dblNumberPtr = (double)number->i; + } + } else { + if (tcl_number_type == TCL_NUMBER_INT) { + *intNumberPtr = number->i; + } else { + *intNumberPtr = (Tcl_WideInt)number->d; + } + } +} + +/* + *---------------------------------------------------------------------- + * + * TclNewArithSeriesObj -- + * + * Creates a new ArithSeries object. Some arguments may be NULL and will + * be computed based on the other given arguments. + * refcount = 0. + * + * Results: + * + * A Tcl_Obj pointer to the created ArithSeries object. + * An empty Tcl_Obj if the range is invalid. + * + * Side Effects: + * + * None. + *---------------------------------------------------------------------- + */ +Tcl_Obj * +TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj) +{ + double dstart, dend, dstep; + Tcl_WideInt start, end, step, len; + + if (startObj) { + assignNumber(useDoubles, &start, &dstart, startObj); + } else { + start = 0; + dstart = start; + } + if (stepObj) { + assignNumber(useDoubles, &step, &dstep, stepObj); + if (useDoubles) { + step = dstep; + } else { + dstep = step; + } + if (dstep == 0) { + return Tcl_NewObj(); + } + } + if (endObj) { + assignNumber(useDoubles, &end, &dend, endObj); + } + if (lenObj) { + Tcl_GetWideIntFromObj(NULL, lenObj, &len); + } + + if (startObj && endObj) { + if (!stepObj) { + if (useDoubles) { + dstep = (dstart < dend) ? 1.0 : -1.0; + step = dstep; + } else { + step = (start < end) ? 1 : -1; + dstep = step; + } + } + assert(dstep!=0); + if (!lenObj) { + if (useDoubles) { + len = (dend - dstart + dstep)/dstep; + } else { + len = (end - start + step)/step; + } + } + } + + if (!endObj) { + if (useDoubles) { + dend = dstart + (dstep * (len-1)); + end = dend; + } else { + end = start + (step * (len-1)); + dend = end; + } + } + + if (useDoubles) { + return TclNewArithSeriesDbl(dstart, dend, dstep, len); + } else { + return TclNewArithSeriesInt(start, end, step, len); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjStep -- + * + * Return a Tcl_Obj with the step value from the give ArithSeries Obj. + * refcount = 0. + * + * Results: + * + * A Tcl_Obj pointer to the created ArithSeries object. + * A NULL pointer of the range is invalid. + * + * Side Effects: + * + * None. + *---------------------------------------------------------------------- + */ +/* + * TclArithSeriesObjStep -- + */ +int +TclArithSeriesObjStep( + Tcl_Obj *arithSeriesPtr, + Tcl_Obj **stepObj) +{ + ArithSeries *arithSeriesRepPtr; + + if (arithSeriesPtr->typePtr != &tclArithSeriesType) { + Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); + } + arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr); + if (arithSeriesRepPtr->isDouble) { + *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step); + } else { + *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); + } + return TCL_OK; +} + + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjIndex -- + * + * Returns the element with the specified index in the list + * represented by the specified Arithmetic Sequence object. + * If the index is out of range, TCL_ERROR is returned, + * otherwise TCL_OK is returned and the integer value of the + * element is stored in *element. + * + * Results: + * + * TCL_OK on success, TCL_ERROR on index out of range. + * + * Side Effects: + * + * On success, the integer pointed by *element is modified. + * + *---------------------------------------------------------------------- + */ + +int +TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, Tcl_WideInt index, Tcl_Obj **elementObj) +{ + ArithSeries *arithSeriesRepPtr; + + if (arithSeriesPtr->typePtr != &tclArithSeriesType) { + Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj."); + } + arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesPtr); + if (index < 0 || index >= arithSeriesRepPtr->len) { + return TCL_ERROR; + } + /* List[i] = Start + (Step * index) */ + if (arithSeriesRepPtr->isDouble) { + *elementObj = Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + } else { + *elementObj = Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index)); + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjLength + * + * Returns the length of the arithmetic series. + * + * Results: + * + * The length of the series as Tcl_WideInt. + * + * Side Effects: + * + * None. + * + *---------------------------------------------------------------------- + */ +Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr) +{ + ArithSeries *arithSeriesRepPtr = (ArithSeries*) + arithSeriesPtr->internalRep.twoPtrValue.ptr1; + return arithSeriesRepPtr->len; +} + +/* + *---------------------------------------------------------------------- + * + * FreeArithSeriesInternalRep -- + * + * Deallocate the storage associated with an arithseries object's + * internal representation. + * + * Results: + * None. + * + * Side effects: + * Frees arithSeriesPtr's ArithSeries* internal representation and + * sets listPtr's internalRep.twoPtrValue.ptr1 to NULL. + * + *---------------------------------------------------------------------- + */ + +static void +FreeArithSeriesInternalRep(Tcl_Obj *arithSeriesPtr) +{ + ArithSeries *arithSeriesRepPtr = + (ArithSeries *) arithSeriesPtr->internalRep.twoPtrValue.ptr1; + if (arithSeriesRepPtr->elements) { + Tcl_WideInt i; + Tcl_Obj**elmts = arithSeriesRepPtr->elements; + for(i=0; i<arithSeriesRepPtr->len; i++) { + if (elmts[i]) { + Tcl_DecrRefCount(elmts[i]); + } + } + Tcl_Free((char *) arithSeriesRepPtr->elements); + } + Tcl_Free((char *) arithSeriesRepPtr); + arithSeriesPtr->internalRep.twoPtrValue.ptr1 = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * DupArithSeriesInternalRep -- + * + * Initialize the internal representation of a arithseries Tcl_Obj to a + * copy of the internal representation of an existing arithseries object. + * + * Results: + * None. + * + * Side effects: + * We set "copyPtr"s internal rep to a pointer to a + * newly allocated ArithSeries structure. + *---------------------------------------------------------------------- + */ + +static void +DupArithSeriesInternalRep( + Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ +{ + ArithSeries *srcArithSeriesRepPtr = + (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1; + ArithSeries *copyArithSeriesRepPtr; + + /* + * Allocate a new ArithSeries structure. */ + + copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries)); + *copyArithSeriesRepPtr = *srcArithSeriesRepPtr; + copyArithSeriesRepPtr->elements = NULL; + copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr; + copyPtr->internalRep.twoPtrValue.ptr2 = NULL; + copyPtr->typePtr = &tclArithSeriesType; +} + +/* + *---------------------------------------------------------------------- + * + * UpdateStringOfArithSeries -- + * + * Update the string representation for an arithseries object. + * Note: This procedure does not invalidate an existing old string rep + * so storage will be lost if this has not already been done. + * + * Results: + * None. + * + * Side effects: + * The object's string is set to a valid string that results from + * the list-to-string conversion. This string will be empty if the + * list has no elements. The list internal representation + * should not be NULL and we assume it is not NULL. + * + * Notes: + * At the cost of overallocation it's possible to estimate + * the length of the string representation and make this procedure + * much faster. Because the programmer shouldn't expect the + * string conversion of a big arithmetic sequence to be fast + * this version takes more care of space than time. + * + *---------------------------------------------------------------------- + */ + +static void +UpdateStringOfArithSeries(Tcl_Obj *arithSeriesPtr) +{ + ArithSeries *arithSeriesRepPtr = + (ArithSeries*) arithSeriesPtr->internalRep.twoPtrValue.ptr1; + char *elem, *p; + Tcl_Obj *elemObj; + Tcl_WideInt i; + Tcl_WideInt length = 0; + int slen; + + /* + * Pass 1: estimate space. + */ + for (i = 0; i < arithSeriesRepPtr->len; i++) { + TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj); + elem = TclGetStringFromObj(elemObj, &slen); + Tcl_DecrRefCount(elemObj); + slen += 1; /* + 1 is for the space or the nul-term */ + length += slen; + } + + /* + * Pass 2: generate the string repr. + */ + + p = Tcl_InitStringRep(arithSeriesPtr, NULL, length); + for (i = 0; i < arithSeriesRepPtr->len; i++) { + TclArithSeriesObjIndex(arithSeriesPtr, i, &elemObj); + elem = TclGetStringFromObj(elemObj, &slen); + strcpy(p, elem); + p[slen] = ' '; + p += slen+1; + Tcl_DecrRefCount(elemObj); + } + if (length > 0) arithSeriesPtr->bytes[length-1] = '\0'; + arithSeriesPtr->length = length-1; +} + +/* + *---------------------------------------------------------------------- + * + * SetArithSeriesFromAny -- + * + * The Arithmetic Series object is just an way to optimize + * Lists space complexity, so no one should try to convert + * a string to an Arithmetic Series object. + * + * This function is here just to populate the Type structure. + * + * Results: + * + * The result is always TCL_ERROR. But see Side Effects. + * + * Side effects: + * + * Tcl Panic if called. + * + *---------------------------------------------------------------------- + */ + +static int +SetArithSeriesFromAny( + TCL_UNUSED(Tcl_Interp *), /* Used for error reporting if not NULL. */ + TCL_UNUSED(Tcl_Obj *)) /* The object to convert. */ +{ + Tcl_Panic("SetArithSeriesFromAny: should never be called"); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjCopy -- + * + * Makes a "pure arithSeries" copy of an ArithSeries value. This provides for the C + * level a counterpart of the [lrange $list 0 end] command, while using + * internals details to be as efficient as possible. + * + * Results: + * + * Normally returns a pointer to a new Tcl_Obj, that contains the same + * arithSeries value as *arithSeriesPtr does. The returned Tcl_Obj has a + * refCount of zero. If *arithSeriesPtr does not hold an arithSeries, + * NULL is returned, and if interp is non-NULL, an error message is + * recorded there. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclArithSeriesObjCopy( + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *arithSeriesPtr) /* List object for which an element array is + * to be returned. */ +{ + Tcl_Obj *copyPtr; + ArithSeries *arithSeriesRepPtr; + + ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr); + if (NULL == arithSeriesRepPtr) { + if (SetArithSeriesFromAny(interp, arithSeriesPtr) != TCL_OK) { + /* We know this is going to panic, but it's the message we want */ + return NULL; + } + } + + TclNewObj(copyPtr); + TclInvalidateStringRep(copyPtr); + DupArithSeriesInternalRep(arithSeriesPtr, copyPtr); + return copyPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjRange -- + * + * Makes a slice of an ArithSeries value. + * *arithSeriesPtr must be known to be a valid list. + * + * Results: + * Returns a pointer to the sliced series. + * This may be a new object or the same object if not shared. + * + * Side effects: + * ?The possible conversion of the object referenced by listPtr? + * ?to a list object.? + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclArithSeriesObjRange( + Tcl_Obj *arithSeriesPtr, /* List object to take a range from. */ + int fromIdx, /* Index of first element to include. */ + int toIdx) /* Index of last element to include. */ +{ + ArithSeries *arithSeriesRepPtr; + Tcl_Obj *startObj, *endObj, *stepObj; + + ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr); + + if (fromIdx < 0) { + fromIdx = 0; + } + if (fromIdx > toIdx) { + Tcl_Obj *obj; + TclNewObj(obj); + return obj; + } + + TclArithSeriesObjIndex(arithSeriesPtr, fromIdx, &startObj); + Tcl_IncrRefCount(startObj); + TclArithSeriesObjIndex(arithSeriesPtr, toIdx, &endObj); + Tcl_IncrRefCount(endObj); + TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + Tcl_IncrRefCount(stepObj); + + if (Tcl_IsShared(arithSeriesPtr) || + ((arithSeriesPtr->refCount > 1))) { + Tcl_Obj *newSlicePtr = TclNewArithSeriesObj(arithSeriesRepPtr->isDouble, + startObj, endObj, stepObj, NULL); + Tcl_DecrRefCount(startObj); + Tcl_DecrRefCount(endObj); + Tcl_DecrRefCount(stepObj); + return newSlicePtr; + } + + /* + * In-place is possible. + */ + + /* + * Even if nothing below causes any changes, we still want the + * string-canonizing effect of [lrange 0 end]. + */ + + TclInvalidateStringRep(arithSeriesPtr); + + if (arithSeriesRepPtr->isDouble) { + ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr; + double start, end, step; + Tcl_GetDoubleFromObj(NULL, startObj, &start); + Tcl_GetDoubleFromObj(NULL, endObj, &end); + Tcl_GetDoubleFromObj(NULL, stepObj, &step); + arithSeriesDblRepPtr->start = start; + arithSeriesDblRepPtr->end = end; + arithSeriesDblRepPtr->step = step; + arithSeriesDblRepPtr->len = (end-start+step)/step; + arithSeriesDblRepPtr->elements = NULL; + + } else { + Tcl_WideInt start, end, step; + Tcl_GetWideIntFromObj(NULL, startObj, &start); + Tcl_GetWideIntFromObj(NULL, endObj, &end); + Tcl_GetWideIntFromObj(NULL, stepObj, &step); + arithSeriesRepPtr->start = start; + arithSeriesRepPtr->end = end; + arithSeriesRepPtr->step = step; + arithSeriesRepPtr->len = (end-start+step)/step; + arithSeriesRepPtr->elements = NULL; + } + + Tcl_DecrRefCount(startObj); + Tcl_DecrRefCount(endObj); + Tcl_DecrRefCount(stepObj); + + return arithSeriesPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesGetElements -- + * + * This function returns an (objc,objv) array of the elements in a list + * object. + * + * Results: + * The return value is normally TCL_OK; in this case *objcPtr is set to + * the count of list elements and *objvPtr is set to a pointer to an + * array of (*objcPtr) pointers to each list element. If listPtr does not + * refer to an Abstract List object and the object can not be converted + * to one, TCL_ERROR is returned and an error message will be left in the + * interpreter's result if interp is not NULL. + * + * The objects referenced by the returned array should be treated as + * readonly and their ref counts are _not_ incremented; the caller must + * do that if it holds on to a reference. Furthermore, the pointer and + * length returned by this function may change as soon as any function is + * called on the list object; be careful about retaining the pointer in a + * local data structure. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclArithSeriesGetElements( + Tcl_Interp *interp, /* Used to report errors if not NULL. */ + Tcl_Obj *objPtr, /* AbstractList object for which an element + * array is to be returned. */ + size_t *objcPtr, /* Where to store the count of objects + * referenced by objv. */ + Tcl_Obj ***objvPtr) /* Where to store the pointer to an array of + * pointers to the list's objects. */ +{ + if (TclHasInternalRep(objPtr,&tclArithSeriesType)) { + ArithSeries *arithSeriesRepPtr; + Tcl_Obj **objv; + int i, objc; + + ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr); + objc = arithSeriesRepPtr->len; + if (objc > 0) { + if (arithSeriesRepPtr->elements) { + /* If this exists, it has already been populated */ + objv = arithSeriesRepPtr->elements; + } else { + /* Construct the elements array */ + objv = (Tcl_Obj **)Tcl_Alloc(sizeof(Tcl_Obj*) * objc); + if (objv == NULL) { + if (interp) { + Tcl_SetObjResult( + interp, + Tcl_NewStringObj("max length of a Tcl list exceeded", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } + arithSeriesRepPtr->elements = objv; + for (i = 0; i < objc; i++) { + if (TclArithSeriesObjIndex(objPtr, i, &objv[i]) != TCL_OK) { + if (interp) { + Tcl_SetObjResult( + interp, + Tcl_NewStringObj("indexing error", -1)); + Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); + } + return TCL_ERROR; + } + Tcl_IncrRefCount(objv[i]); + } + } + } else { + objv = NULL; + } + *objvPtr = objv; + *objcPtr = objc; + } else { + if (interp != NULL) { + Tcl_SetObjResult( + interp, + Tcl_ObjPrintf("value is not an arithseries")); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); + } + return TCL_ERROR; + } + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TclArithSeriesObjReverse -- + * + * Reverse the order of the ArithSeries value. + * *arithSeriesPtr must be known to be a valid list. + * + * Results: + * Returns a pointer to the reordered series. + * This may be a new object or the same object if not shared. + * + * Side effects: + * ?The possible conversion of the object referenced by listPtr? + * ?to a list object.? + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclArithSeriesObjReverse( + Tcl_Obj *arithSeriesPtr) /* List object to reverse. */ +{ + ArithSeries *arithSeriesRepPtr; + Tcl_Obj *startObj, *endObj, *stepObj; + Tcl_Obj *resultObj; + Tcl_WideInt start, end, step, len; + double dstart, dend, dstep; + int isDouble; + + ArithSeriesGetInternalRep(arithSeriesPtr, arithSeriesRepPtr); + + isDouble = arithSeriesRepPtr->isDouble; + len = arithSeriesRepPtr->len; + + TclArithSeriesObjIndex(arithSeriesPtr, (len-1), &startObj); + TclArithSeriesObjIndex(arithSeriesPtr, 0, &endObj); + TclArithSeriesObjStep(arithSeriesPtr, &stepObj); + + if (isDouble) { + Tcl_GetDoubleFromObj(NULL, startObj, &dstart); + Tcl_GetDoubleFromObj(NULL, endObj, &dend); + Tcl_GetDoubleFromObj(NULL, stepObj, &dstep); + dstep = -dstep; + TclSetDoubleObj(stepObj, dstep); + } else { + Tcl_GetWideIntFromObj(NULL, startObj, &start); + Tcl_GetWideIntFromObj(NULL, endObj, &end); + Tcl_GetWideIntFromObj(NULL, stepObj, &step); + step = -step; + TclSetIntObj(stepObj, step); + } + + if (Tcl_IsShared(arithSeriesPtr) || + ((arithSeriesPtr->refCount > 1))) { + Tcl_Obj *lenObj = Tcl_NewWideIntObj(len); + resultObj = TclNewArithSeriesObj(isDouble, + startObj, endObj, stepObj, lenObj); + Tcl_DecrRefCount(lenObj); + } else { + + /* + * In-place is possible. + */ + + TclInvalidateStringRep(arithSeriesPtr); + + if (isDouble) { + ArithSeriesDbl *arithSeriesDblRepPtr = + (ArithSeriesDbl*)arithSeriesRepPtr; + arithSeriesDblRepPtr->start = dstart; + arithSeriesDblRepPtr->end = dend; + arithSeriesDblRepPtr->step = dstep; + } else { + arithSeriesRepPtr->start = start; + arithSeriesRepPtr->end = end; + arithSeriesRepPtr->step = step; + } + if (arithSeriesRepPtr->elements) { + Tcl_WideInt i; + for (i=0; i<len; i++) { + Tcl_DecrRefCount(arithSeriesRepPtr->elements[i]); + } + Tcl_Free((char*)arithSeriesRepPtr->elements); + } + arithSeriesRepPtr->elements = NULL; + + resultObj = arithSeriesPtr; + } + + Tcl_DecrRefCount(startObj); + Tcl_DecrRefCount(endObj); + Tcl_DecrRefCount(stepObj); + + return resultObj; +} diff --git a/generic/tclArithSeries.h b/generic/tclArithSeries.h new file mode 100644 index 0000000..c4bfbfe --- /dev/null +++ b/generic/tclArithSeries.h @@ -0,0 +1,54 @@ +/* + * tclArithSeries.h -- + * + * This file contains the ArithSeries concrete abstract list + * implementation. It implements the inner workings of the lseq command. + * + * Copyright © 2022 Brian S. Griffin. + * + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. + */ + +/* + * The structure used for the ArithSeries internal representation. + * Note that the len can in theory be always computed by start,end,step + * but it's faster to cache it inside the internal representation. + */ +typedef struct ArithSeries { + Tcl_WideInt start; + Tcl_WideInt end; + Tcl_WideInt step; + Tcl_WideInt len; + Tcl_Obj **elements; + int isDouble; +} ArithSeries; +typedef struct ArithSeriesDbl { + double start; + double end; + double step; + Tcl_WideInt len; + Tcl_Obj **elements; + int isDouble; +} ArithSeriesDbl; + + +MODULE_SCOPE Tcl_Obj * TclArithSeriesObjCopy(Tcl_Interp *interp, + Tcl_Obj *arithSeriesPtr); +MODULE_SCOPE int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, + Tcl_Obj **stepObj); +MODULE_SCOPE int TclArithSeriesObjIndex(Tcl_Obj *arithSeriesPtr, + Tcl_WideInt index, Tcl_Obj **elementObj); +MODULE_SCOPE Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesPtr); +MODULE_SCOPE Tcl_Obj * TclArithSeriesObjRange(Tcl_Obj *arithSeriesPtr, + int fromIdx, int toIdx); +MODULE_SCOPE Tcl_Obj * TclArithSeriesObjReverse(Tcl_Obj *arithSeriesPtr); +MODULE_SCOPE int TclArithSeriesGetElements(Tcl_Interp *interp, + Tcl_Obj *objPtr, size_t *objcPtr, Tcl_Obj ***objvPtr); +MODULE_SCOPE Tcl_Obj * TclNewArithSeriesInt(Tcl_WideInt start, + Tcl_WideInt end, Tcl_WideInt step, + Tcl_WideInt len); +MODULE_SCOPE Tcl_Obj * TclNewArithSeriesDbl(double start, double end, + double step, Tcl_WideInt len); +MODULE_SCOPE Tcl_Obj * TclNewArithSeriesObj(int useDoubles, Tcl_Obj *startObj, + Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index bac9b9a..787c52d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -309,6 +309,7 @@ static const CmdInfo builtInCmds[] = { {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index bf7a9cd..6a45a0b 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -15,6 +15,7 @@ #ifdef _WIN32 # include "tclWinInt.h" #endif +#include "tclArithSeries.h" /* * The state structure used by [foreach]. Note that the actual structure has @@ -1265,14 +1266,18 @@ FileAttrLinkStatCmd( { Tcl_StatBuf buf; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "name varName"); + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSLstat, &buf) != TCL_OK) { return TCL_ERROR; } - return StoreStatData(interp, objv[2], &buf); + if (objc == 2) { + return StoreStatData(interp, NULL, &buf); + } else { + return StoreStatData(interp, objv[2], &buf); + } } /* @@ -1301,14 +1306,18 @@ FileAttrStatCmd( { Tcl_StatBuf buf; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "name varName"); + if (objc < 2 || objc > 3) { + Tcl_WrongNumArgs(interp, 1, objv, "name ?varName?"); return TCL_ERROR; } if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) { return TCL_ERROR; } - return StoreStatData(interp, objv[2], &buf); + if (objc == 2) { + return StoreStatData(interp, NULL, &buf); + } else { + return StoreStatData(interp, objv[2], &buf); + } } /* @@ -2208,7 +2217,7 @@ GetStatBuf( * * This is a utility procedure that breaks out the fields of a "stat" * structure and stores them in textual form into the elements of an - * associative array. + * associative array (if given) or returns a dictionary. * * Results: * Returns a standard Tcl return value. If an error occurs then a message @@ -2228,9 +2237,40 @@ StoreStatData( Tcl_StatBuf *statPtr) /* Pointer to buffer containing stat data to * store in varName. */ { - Tcl_Obj *field, *value; + Tcl_Obj *field, *value, *result; unsigned short mode; + if (varName == NULL) { + result = Tcl_NewObj(); + Tcl_IncrRefCount(result); +#define DOBJPUT(key, objValue) \ + Tcl_DictObjPut(NULL, result, \ + Tcl_NewStringObj((key), -1), \ + (objValue)); + DOBJPUT("dev", Tcl_NewWideIntObj((long)statPtr->st_dev)); + DOBJPUT("ino", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino)); + DOBJPUT("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink)); + DOBJPUT("uid", Tcl_NewWideIntObj((long)statPtr->st_uid)); + DOBJPUT("gid", Tcl_NewWideIntObj((long)statPtr->st_gid)); + DOBJPUT("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size)); +#ifdef HAVE_STRUCT_STAT_ST_BLOCKS + DOBJPUT("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks)); +#endif +#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE + DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize)); +#endif + DOBJPUT("atime", Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr))); + DOBJPUT("mtime", Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr))); + DOBJPUT("ctime", Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr))); + mode = (unsigned short) statPtr->st_mode; + DOBJPUT("mode", Tcl_NewWideIntObj(mode)); + DOBJPUT("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1)); +#undef DOBJPUT + Tcl_SetObjResult(interp, result); + Tcl_DecrRefCount(result); + return TCL_OK; + } + /* * Assume Tcl_ObjSetVar2() does not keep a copy of the field name! * @@ -2657,32 +2697,47 @@ EachloopCmd( */ for (i=0 ; i<numLists ; i++) { + /* List */ + /* Variables */ statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]); if (statePtr->vCopyList[i] == NULL) { result = TCL_ERROR; goto done; } TclListObjGetElementsM(NULL, statePtr->vCopyList[i], - &statePtr->varcList[i], &statePtr->varvList[i]); + &statePtr->varcList[i], &statePtr->varvList[i]); if (statePtr->varcList[i] < 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "%s varlist is empty", - (statePtr->resultList != NULL ? "lmap" : "foreach"))); + "%s varlist is empty", + (statePtr->resultList != NULL ? "lmap" : "foreach"))); Tcl_SetErrorCode(interp, "TCL", "OPERATION", - (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), - "NEEDVARS", NULL); + (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), + "NEEDVARS", NULL); result = TCL_ERROR; goto done; } - statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); - if (statePtr->aCopyList[i] == NULL) { - result = TCL_ERROR; - goto done; - } - TclListObjGetElementsM(NULL, statePtr->aCopyList[i], + /* Values */ + if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType)) { + /* Special case for Arith Series */ + statePtr->vCopyList[i] = TclArithSeriesObjCopy(interp, objv[2+i*2]); + if (statePtr->vCopyList[i] == NULL) { + result = TCL_ERROR; + goto done; + } + /* Don't compute values here, wait until the last momement */ + statePtr->argcList[i] = TclArithSeriesObjLength(statePtr->vCopyList[i]); + } else { + /* List values */ + statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]); + if (statePtr->aCopyList[i] == NULL) { + result = TCL_ERROR; + goto done; + } + TclListObjGetElementsM(NULL, statePtr->aCopyList[i], &statePtr->argcList[i], &statePtr->argvList[i]); - + } + /* account for variable <> value mismatch */ j = statePtr->argcList[i] / statePtr->varcList[i]; if ((statePtr->argcList[i] % statePtr->varcList[i]) != 0) { j++; @@ -2805,11 +2860,21 @@ ForeachAssignments( Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; i<statePtr->numLists ; i++) { + int isarithseries = TclHasInternalRep(statePtr->vCopyList[i],&tclArithSeriesType); for (v=0 ; v<statePtr->varcList[i] ; v++) { k = statePtr->index[i]++; - if (k < statePtr->argcList[i]) { - valuePtr = statePtr->argvList[i][k]; + if (isarithseries) { + if (TclArithSeriesObjIndex(statePtr->vCopyList[i], k, &valuePtr) != TCL_OK) { + Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( + "\n (setting %s loop variable \"%s\")", + (statePtr->resultList != NULL ? "lmap" : "foreach"), + TclGetString(statePtr->varvList[i][v]))); + return TCL_ERROR; + } + } else { + valuePtr = statePtr->argvList[i][k]; + } } else { TclNewObj(valuePtr); /* Empty string */ } diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 031168f..64eb37c 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -19,6 +19,9 @@ #include "tclInt.h" #include "tclRegexp.h" +#include "tclArithSeries.h" +#include <math.h> +#include <assert.h> /* * During execution of the "lsort" command, structures of the following type @@ -94,6 +97,23 @@ typedef struct { #define SORTMODE_ASCII_NC 8 /* + * Definitions for [lseq] command + */ +static const char *const seq_operations[] = { + "..", "to", "count", "by", NULL +}; +typedef enum Sequence_Operators { + LSEQ_DOTS, LSEQ_TO, LSEQ_COUNT, LSEQ_BY +} SequenceOperators; +static const char *const seq_step_keywords[] = {"by", NULL}; +typedef enum Step_Operators { + STEP_BY = 4 +} SequenceByMode; +typedef enum Sequence_Decoded { + NoneArg, NumericArg, RangeKeywordArg, ByKeywordArg +} SequenceDecoded; + +/* * Forward declarations for procedures defined in this file: */ @@ -2181,6 +2201,7 @@ Tcl_JoinObjCmd( Tcl_Obj *const objv[]) /* The argument objects. */ { size_t length, listLen; + int isArithSeries = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { @@ -2193,9 +2214,14 @@ Tcl_JoinObjCmd( * pointer to its array of element pointers. */ - if (TclListObjGetElementsM(interp, objv[1], &listLen, + if (TclHasInternalRep(objv[1],&tclArithSeriesType)) { + isArithSeries = 1; + listLen = TclArithSeriesObjLength(objv[1]); + } else { + if (TclListObjGetElementsM(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; + } } if (listLen == 0) { @@ -2204,7 +2230,15 @@ Tcl_JoinObjCmd( } if (listLen == 1) { /* One element; return it */ - Tcl_SetObjResult(interp, elemPtrs[0]); + if (isArithSeries) { + Tcl_Obj *valueObj; + if (TclArithSeriesObjIndex(objv[1], 0, &valueObj) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetObjResult(interp, valueObj); + } else { + Tcl_SetObjResult(interp, elemPtrs[0]); + } return TCL_OK; } @@ -2218,19 +2252,41 @@ Tcl_JoinObjCmd( size_t i; resObjPtr = Tcl_NewObj(); - for (i = 0; i < listLen; i++) { - if (i > 0) { + if (isArithSeries) { + Tcl_Obj *valueObj; + for (i = 0; i < listLen; i++) { + if (i > 0) { + + /* + * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** + * to shimmer joinObjPtr. If it did, then the case where + * objv[1] and objv[2] are the same value would not be safe. + * Accessing elemPtrs would crash. + */ + + Tcl_AppendObjToObj(resObjPtr, joinObjPtr); + } + if (TclArithSeriesObjIndex(objv[1], i, &valueObj) != TCL_OK) { + return TCL_ERROR; + } + Tcl_AppendObjToObj(resObjPtr, valueObj); + Tcl_DecrRefCount(valueObj); + } + } else { + for (i = 0; i < listLen; i++) { + if (i > 0) { - /* - * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** - * to shimmer joinObjPtr. If it did, then the case where - * objv[1] and objv[2] are the same value would not be safe. - * Accessing elemPtrs would crash. - */ + /* + * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT** + * to shimmer joinObjPtr. If it did, then the case where + * objv[1] and objv[2] are the same value would not be safe. + * Accessing elemPtrs would crash. + */ - Tcl_AppendObjToObj(resObjPtr, joinObjPtr); + Tcl_AppendObjToObj(resObjPtr, joinObjPtr); + } + Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } - Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } } Tcl_DecrRefCount(joinObjPtr); @@ -2691,7 +2747,11 @@ Tcl_LrangeObjCmd( return result; } - Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); + if (TclHasInternalRep(objv[1],&tclArithSeriesType)) { + Tcl_SetObjResult(interp, TclArithSeriesObjRange(objv[1], first, last)); + } else { + Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); + } return TCL_OK; } @@ -3075,6 +3135,17 @@ Tcl_LreverseObjCmd( Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } + + /* + * Handle ArithSeries special case - don't shimmer a series into a list + * just to reverse it. + */ + if (TclHasInternalRep(objv[1],&tclArithSeriesType)) { + Tcl_SetObjResult(interp, TclArithSeriesObjReverse(objv[1])); + return TCL_OK; + } /* end ArithSeries */ + + /* True List */ if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) { return TCL_ERROR; } @@ -3979,6 +4050,407 @@ Tcl_LsetObjCmd( /* *---------------------------------------------------------------------- * + * SequenceIdentifyArgument -- + * (for [lseq] command) + * + * Given a Tcl_Obj, identify if it is a keyword or a number + * + * Return Value + * 0 - failure, unexpected value + * 1 - value is a number + * 2 - value is an operand keyword + * 3 - value is a by keyword + * + * The decoded value will be assigned to the appropriate + * pointer, if supplied. + */ + +static SequenceDecoded +SequenceIdentifyArgument( + Tcl_Interp *interp, /* for error reporting */ + Tcl_Obj *argPtr, /* Argument to decode */ + Tcl_Obj **numValuePtr, /* Return numeric value */ + int *keywordIndexPtr) /* Return keyword enum */ +{ + int status; + SequenceOperators opmode; + SequenceByMode bymode; + union { + Tcl_WideInt i; + double d; + } nvalue; + + status = TclGetNumberFromObj(NULL, argPtr, (ClientData*)&nvalue, keywordIndexPtr); + if (status == TCL_OK) { + if (numValuePtr) { + *numValuePtr = argPtr; + } + return NumericArg; + } else { + /* Check for an index expression */ + long value; + double dvalue; + Tcl_Obj *exprValueObj; + int keyword; + Tcl_InterpState savedstate; + savedstate = Tcl_SaveInterpState(interp, status); + if (Tcl_ExprLongObj(interp, argPtr, &value) != TCL_OK) { + status = Tcl_RestoreInterpState(interp, savedstate); + exprValueObj = argPtr; + } else { + // Determine if expression is double or int + if (Tcl_ExprDoubleObj(interp, argPtr, &dvalue) != TCL_OK) { + keyword = TCL_NUMBER_INT; + exprValueObj = argPtr; + } else { + if (floor(dvalue) == dvalue) { + exprValueObj = Tcl_NewWideIntObj(value); + keyword = TCL_NUMBER_INT; + } else { + exprValueObj = Tcl_NewDoubleObj(dvalue); + keyword = TCL_NUMBER_DOUBLE; + } + } + status = Tcl_RestoreInterpState(interp, savedstate); + if (numValuePtr) { + *numValuePtr = exprValueObj; + } + if (keywordIndexPtr) { + *keywordIndexPtr = keyword ;// type of expression result + } + return NumericArg; + } + } + + status = Tcl_GetIndexFromObj(NULL, argPtr, seq_operations, + "range operation", 0, &opmode); + if (status == TCL_OK) { + if (keywordIndexPtr) { + *keywordIndexPtr = opmode; + } + return RangeKeywordArg; + } + + status = Tcl_GetIndexFromObj(NULL, argPtr, seq_step_keywords, + "step keyword", 0, &bymode); + if (status == TCL_OK) { + if (keywordIndexPtr) { + *keywordIndexPtr = bymode; + } + return ByKeywordArg; + } + return NoneArg; +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_LseqObjCmd -- + * + * This procedure is invoked to process the "lseq" Tcl command. + * See the user documentation for details on what it does. + * + * Enumerated possible argument patterns: + * + * 1: + * lseq n + * 2: + * lseq n n + * 3: + * lseq n n n + * lseq n 'to' n + * lseq n 'count' n + * lseq n 'by' n + * 4: + * lseq n 'to' n n + * lseq n n 'by' n + * lseq n 'count' n n + * 5: + * lseq n 'to' n 'by' n + * lseq n 'count' n 'by' n + * + * Results: + * A standard Tcl object result. + * + * Side effects: + * See the user documentation. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_LseqObjCmd( + TCL_UNUSED(ClientData), + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* The argument objects. */ +{ + Tcl_Obj *elementCount = NULL; + Tcl_Obj *start = NULL, *end = NULL, *step = NULL; + Tcl_WideInt values[5]; + Tcl_Obj *numValues[5]; + Tcl_Obj *numberObj; + int status, keyword, useDoubles = 0; + Tcl_Obj *arithSeriesPtr; + SequenceOperators opmode; + SequenceDecoded decoded; + int i, arg_key = 0, value_i = 0; + // Default constants + Tcl_Obj *zero = Tcl_NewIntObj(0); + Tcl_Obj *one = Tcl_NewIntObj(1); + + /* + * Create a decoding key by looping through the arguments and identify + * what kind of argument each one is. Encode each argument as a decimal + * digit. + */ + if (objc > 6) { + /* Too many arguments */ + arg_key=0; + } else for (i=1; i<objc; i++) { + arg_key = (arg_key * 10); + numValues[value_i] = NULL; + decoded = SequenceIdentifyArgument(interp, objv[i], &numberObj, &keyword); + switch (decoded) { + + case NoneArg: + /* + * Unrecognizable argument + * Reproduce operation error message + */ + status = Tcl_GetIndexFromObj(interp, objv[i], seq_operations, + "operation", 0, &opmode); + goto done; + + case NumericArg: + arg_key += NumericArg; + numValues[value_i] = numberObj; + Tcl_IncrRefCount(numValues[value_i]); + values[value_i] = keyword; // This is the TCL_NUMBER_* value + useDoubles = useDoubles ? useDoubles : keyword == TCL_NUMBER_DOUBLE; + value_i++; + break; + + case RangeKeywordArg: + arg_key += RangeKeywordArg; + values[value_i] = keyword; + value_i++; + break; + + case ByKeywordArg: + arg_key += ByKeywordArg; + values[value_i] = keyword; + value_i++; + break; + + default: + arg_key += 9; // Error state + value_i++; + break; + } + } + + /* + * The key encoding defines a valid set of arguments, or indicates an + * error condition; process the values accordningly. + */ + switch (arg_key) { + +/* No argument */ + case 0: + Tcl_WrongNumArgs(interp, 1, objv, + "n ??op? n ??by? n??"); + status = TCL_ERROR; + goto done; + break; + +/* range n */ + case 1: + start = zero; + elementCount = numValues[0]; + end = NULL; + step = one; + break; + +/* range n n */ + case 11: + start = numValues[0]; + end = numValues[1]; + break; + +/* range n n n */ + case 111: + start = numValues[0]; + end = numValues[1]; + step = numValues[2]; + break; + +/* range n 'to' n */ +/* range n 'count' n */ +/* range n 'by' n */ + case 121: + opmode = (SequenceOperators)values[1]; + switch (opmode) { + case LSEQ_DOTS: + case LSEQ_TO: + start = numValues[0]; + end = numValues[2]; + break; + case LSEQ_BY: + start = zero; + elementCount = numValues[0]; + step = numValues[2]; + break; + case LSEQ_COUNT: + start = numValues[0]; + elementCount = numValues[2]; + step = one; + break; + default: + status = TCL_ERROR; + goto done; + } + break; + +/* range n 'to' n n */ +/* range n 'count' n n */ + case 1211: + opmode = (SequenceOperators)values[1]; + switch (opmode) { + case LSEQ_DOTS: + case LSEQ_TO: + start = numValues[0]; + end = numValues[2]; + step = numValues[3]; + break; + case LSEQ_COUNT: + start = numValues[0]; + elementCount = numValues[2]; + step = numValues[3]; + break; + case LSEQ_BY: + /* Error case */ + status = TCL_ERROR; + goto done; + break; + default: + status = TCL_ERROR; + goto done; + break; + } + break; + +/* range n n 'by' n */ + case 1121: + start = numValues[0]; + end = numValues[1]; + opmode = (SequenceOperators)values[2]; + switch (opmode) { + case LSEQ_BY: + step = numValues[3]; + break; + case LSEQ_DOTS: + case LSEQ_TO: + case LSEQ_COUNT: + default: + status = TCL_ERROR; + goto done; + break; + } + break; + +/* range n 'to' n 'by' n */ +/* range n 'count' n 'by' n */ + case 12121: + start = numValues[0]; + opmode = (SequenceOperators)values[3]; + switch (opmode) { + case LSEQ_BY: + step = numValues[4]; + break; + default: + status = TCL_ERROR; + goto done; + break; + } + opmode = (SequenceOperators)values[1]; + switch (opmode) { + case LSEQ_DOTS: + case LSEQ_TO: + start = numValues[0]; + end = numValues[2]; + break; + case LSEQ_COUNT: + start = numValues[0]; + elementCount = numValues[2]; + break; + default: + status = TCL_ERROR; + goto done; + break; + } + break; + +/* Error cases: incomplete arguments */ + case 12: + opmode = (SequenceOperators)values[1]; goto KeywordError; break; + case 112: + opmode = (SequenceOperators)values[2]; goto KeywordError; break; + case 1212: + opmode = (SequenceOperators)values[3]; goto KeywordError; break; + KeywordError: + status = TCL_ERROR; + switch (opmode) { + case LSEQ_DOTS: + case LSEQ_TO: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing \"to\" value.")); + break; + case LSEQ_COUNT: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing \"count\" value.")); + break; + case LSEQ_BY: + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "missing \"by\" value.")); + break; + } + status = TCL_ERROR; + goto done; + break; + +/* All other argument errors */ + default: + Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); + status = TCL_ERROR; + goto done; + break; + } + + /* + * Success! Now lets create the series object. + */ + arithSeriesPtr = TclNewArithSeriesObj(useDoubles, start, end, step, elementCount); + + Tcl_SetObjResult(interp, arithSeriesPtr); + status = TCL_OK; + + done: + // Free number arguments. + while (--value_i>=0) { + if (numValues[value_i]) Tcl_DecrRefCount(numValues[value_i]); + } + + // Free constants + Tcl_DecrRefCount(zero); + Tcl_DecrRefCount(one); + + return status; +} + +/* + *---------------------------------------------------------------------- + * * Tcl_LsortObjCmd -- * * This procedure is invoked to process the "lsort" Tcl command. See the @@ -4247,8 +4719,13 @@ Tcl_LsortObjCmd( sortInfo.compareCmdPtr = newCommandPtr; } - sortInfo.resultCode = TclListObjGetElementsM(interp, listObj, + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + sortInfo.resultCode = TclArithSeriesGetElements(interp, + listObj, &length, &listObjPtrs); + } else { + sortInfo.resultCode = TclListObjGetElementsM(interp, listObj, &length, &listObjPtrs); + } if (sortInfo.resultCode != TCL_OK || length <= 0) { goto done; } diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 885df49..8a08f53 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -3760,8 +3760,12 @@ TclNRSwitchObjCmd( if (matchVarObj != NULL) { Tcl_Obj *substringObj; - substringObj = Tcl_GetRange(stringObj, - info.matches[j].start, info.matches[j].end-1); + if (info.matches[j].end + 1 > 1) { + substringObj = Tcl_GetRange(stringObj, + info.matches[j].start, info.matches[j].end-1); + } else { + TclNewObj(substringObj); + } /* * Never fails; the object is always clean at this point. diff --git a/generic/tclDecls.h b/generic/tclDecls.h index cc8c683..b4ba4d9 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -531,8 +531,7 @@ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel(void *handle, int mode); -/* 190 */ -EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); +/* Slot 190 is reserved */ /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(void *tcpSocket); /* 192 */ @@ -1834,6 +1833,11 @@ EXTERN Tcl_Command Tcl_NRCreateCommand2(Tcl_Interp *interp, EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); +/* Slot 680 is reserved */ +/* Slot 681 is reserved */ +/* 682 */ +EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, + Tcl_Channel chan, int mode); typedef struct { const struct TclPlatStubs *tclPlatStubs; @@ -2035,7 +2039,7 @@ typedef struct TclStubs { int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, void *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (void *handle, int mode); /* 189 */ - int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ + void (*reserved190)(void); Tcl_Channel (*tcl_MakeTcpClientChannel) (void *tcpSocket); /* 191 */ char * (*tcl_Merge) (Tcl_Size argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ @@ -2525,6 +2529,9 @@ typedef struct TclStubs { Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */ + void (*reserved680)(void); + void (*reserved681)(void); + int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -2896,8 +2903,7 @@ extern const TclStubs *tclStubsPtr; /* Slot 188 is reserved */ #define Tcl_MakeFileChannel \ (tclStubsPtr->tcl_MakeFileChannel) /* 189 */ -#define Tcl_MakeSafe \ - (tclStubsPtr->tcl_MakeSafe) /* 190 */ +/* Slot 190 is reserved */ #define Tcl_MakeTcpClientChannel \ (tclStubsPtr->tcl_MakeTcpClientChannel) /* 191 */ #define Tcl_Merge \ @@ -3836,6 +3842,10 @@ extern const TclStubs *tclStubsPtr; (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */ #define Tcl_NRCallObjProc2 \ (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ +/* Slot 680 is reserved */ +/* Slot 681 is reserved */ +#define Tcl_RemoveChannelMode \ + (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #endif /* defined(USE_TCL_STUBS) */ @@ -3888,20 +3898,28 @@ extern const TclStubs *tclStubsPtr; #define Tcl_GlobalEval(interp, objPtr) \ Tcl_EvalEx(interp, objPtr, TCL_INDEX_NONE, TCL_EVAL_GLOBAL) #define Tcl_GetStringResult(interp) Tcl_GetString(Tcl_GetObjResult(interp)) +inline TCL_DEPRECATED_API("Use Tcl_SaveInterpState") void Tcl_SaveResult_(void) {} #define Tcl_SaveResult(interp, statePtr) \ do { \ + Tcl_SaveResult_(); \ *(statePtr) = Tcl_GetObjResult(interp); \ Tcl_IncrRefCount(*(statePtr)); \ Tcl_SetObjResult(interp, Tcl_NewObj()); \ } while(0) +inline TCL_DEPRECATED_API("Use Tcl_RestoreInterpState") void Tcl_RestoreResult_(void) {} #define Tcl_RestoreResult(interp, statePtr) \ do { \ + Tcl_RestoreResult_(); \ Tcl_ResetResult(interp); \ Tcl_SetObjResult(interp, *(statePtr)); \ Tcl_DecrRefCount(*(statePtr)); \ } while(0) +inline TCL_DEPRECATED_API("Use Tcl_DiscardInterpState") void Tcl_DiscardResult_(void) {} #define Tcl_DiscardResult(statePtr) \ - Tcl_DecrRefCount(*(statePtr)) + do { \ + Tcl_DiscardResult_(); \ + Tcl_DecrRefCount(*(statePtr)); \ + } while(0) #define Tcl_SetResult(interp, result, freeProc) \ do { \ const char *__result = result; \ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 6445ca3..6d7d968 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -50,6 +50,19 @@ typedef struct { } ErrAssocData; /* + * For each "vwait" event source a structure of the following type + * is used: + */ + +typedef struct { + int *donePtr; /* Pointer to flag to signal or NULL. */ + int sequence; /* Order of occurrence. */ + int mask; /* 0, or TCL_READABLE/TCL_WRITABLE. */ + Tcl_Obj *sourceObj; /* Name of the event source, either a + * variable name or channel name. */ +} VwaitItem; + +/* * For each exit handler created with a call to Tcl_Create(Late)ExitHandler * there is a structure of the following type: */ @@ -116,6 +129,9 @@ static Tcl_ThreadCreateType NewThreadProc(void *clientData); static void BgErrorDeleteProc(void *clientData, Tcl_Interp *interp); static void HandleBgErrors(void *clientData); +static void VwaitChannelReadProc(void *clientData, int mask); +static void VwaitChannelWriteProc(void *clientData, int mask); +static void VwaitTimeoutProc(void *clientData); static char * VwaitVarProc(void *clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); @@ -1477,73 +1493,430 @@ Tcl_VwaitObjCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - int done, foundEvent; - const char *nameString; + int i, done = 0, timedOut = 0, foundEvent, any = 1, timeout = 0; + int numItems = 0, extended = 0, result, mode, mask = TCL_ALL_EVENTS; + Tcl_InterpState saved = NULL; + Tcl_TimerToken timer = NULL; + Tcl_Time before, after; + Tcl_Channel chan; + Tcl_WideInt diff = -1; + VwaitItem localItems[32], *vwaitItems = localItems; + static const char *const options[] = { + "-all", "-extended", "-nofileevents", "-noidleevents", + "-notimerevents", "-nowindowevents", "-readable", + "-timeout", "-variable", "-writable", "--", NULL + }; + enum options { + OPT_ALL, OPT_EXTD, OPT_NO_FEVTS, OPT_NO_IEVTS, + OPT_NO_TEVTS, OPT_NO_WEVTS, OPT_READABLE, + OPT_TIMEOUT, OPT_VARIABLE, OPT_WRITABLE, OPT_LAST + } index; - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "name"); - return TCL_ERROR; + if ((objc == 2) && (strcmp(Tcl_GetString(objv[1]), "--") != 0)) { + /* + * Legacy "vwait" syntax, skip option handling. + */ + i = 1; + goto endOfOptionLoop; } - nameString = TclGetString(objv[1]); - if (Tcl_TraceVar2(interp, nameString, NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, &done) != TCL_OK) { - return TCL_ERROR; - }; - done = 0; + + if ((unsigned) objc - 1 > sizeof(localItems) / sizeof(localItems[0])) { + vwaitItems = (VwaitItem *) Tcl_Alloc(sizeof(VwaitItem) * (objc - 1)); + } + + for (i = 1; i < objc; i++) { + const char *name; + + name = TclGetString(objv[i]); + if (name[0] != '-') { + break; + } + if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, + &index) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + switch (index) { + case OPT_ALL: + any = 0; + break; + case OPT_EXTD: + extended = 1; + break; + case OPT_NO_FEVTS: + mask &= ~TCL_FILE_EVENTS; + break; + case OPT_NO_IEVTS: + mask &= ~TCL_IDLE_EVENTS; + break; + case OPT_NO_TEVTS: + mask &= ~TCL_TIMER_EVENTS; + break; + case OPT_NO_WEVTS: + mask &= ~TCL_WINDOW_EVENTS; + break; + case OPT_TIMEOUT: + if (++i >= objc) { + needArg: + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "argument required for \"%s\"", options[index])); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "ARGUMENT", NULL); + result = TCL_ERROR; + goto done; + } + if (Tcl_GetIntFromObj(interp, objv[i], &timeout) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (timeout < 0) { + Tcl_ResetResult(interp); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "timeout must be positive", -1)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NEGTIME", NULL); + result = TCL_ERROR; + goto done; + } + break; + case OPT_LAST: + i++; + goto endOfOptionLoop; + case OPT_VARIABLE: + if (++i >= objc) { + goto needArg; + } + result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VwaitVarProc, &vwaitItems[numItems]); + if (result != TCL_OK) { + goto done; + } + vwaitItems[numItems].donePtr = &done; + vwaitItems[numItems].sequence = -1; + vwaitItems[numItems].mask = 0; + vwaitItems[numItems].sourceObj = objv[i]; + numItems++; + break; + case OPT_READABLE: + if (++i >= objc) { + goto needArg; + } + if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0) + != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (!(mode & TCL_READABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't open for reading", + TclGetString(objv[i]))); + result = TCL_ERROR; + goto done; + } + Tcl_CreateChannelHandler(chan, TCL_READABLE, + VwaitChannelReadProc, &vwaitItems[numItems]); + vwaitItems[numItems].donePtr = &done; + vwaitItems[numItems].sequence = -1; + vwaitItems[numItems].mask = TCL_READABLE; + vwaitItems[numItems].sourceObj = objv[i]; + numItems++; + break; + case OPT_WRITABLE: + if (++i >= objc) { + goto needArg; + } + if (TclGetChannelFromObj(interp, objv[i], &chan, &mode, 0) + != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (!(mode & TCL_WRITABLE)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "channel \"%s\" wasn't open for writing", + TclGetString(objv[i]))); + result = TCL_ERROR; + goto done; + } + Tcl_CreateChannelHandler(chan, TCL_WRITABLE, + VwaitChannelWriteProc, &vwaitItems[numItems]); + vwaitItems[numItems].donePtr = &done; + vwaitItems[numItems].sequence = -1; + vwaitItems[numItems].mask = TCL_WRITABLE; + vwaitItems[numItems].sourceObj = objv[i]; + numItems++; + break; + } + } + + endOfOptionLoop: + if ((mask & (TCL_FILE_EVENTS | TCL_IDLE_EVENTS | + TCL_TIMER_EVENTS | TCL_WINDOW_EVENTS)) == 0) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can't wait: would block forever", -1)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); + result = TCL_ERROR; + goto done; + } + + if ((timeout > 0) && ((mask & TCL_TIMER_EVENTS) == 0)) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "timer events disabled with timeout specified", -1)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_TIME", NULL); + result = TCL_ERROR; + goto done; + } + + for (result = TCL_OK; i < objc; i++) { + result = Tcl_TraceVar2(interp, TclGetString(objv[i]), NULL, + TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VwaitVarProc, &vwaitItems[numItems]); + if (result != TCL_OK) { + break; + } + vwaitItems[numItems].donePtr = &done; + vwaitItems[numItems].sequence = -1; + vwaitItems[numItems].mask = 0; + vwaitItems[numItems].sourceObj = objv[i]; + numItems++; + } + if (result != TCL_OK) { + result = TCL_ERROR; + goto done; + } + + if (!(mask & TCL_FILE_EVENTS)) { + for (i = 0; i < numItems; i++) { + if (vwaitItems[i].mask) { + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "file events disabled with channel(s) specified", -1)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_FILE_EVENT", NULL); + result = TCL_ERROR; + goto done; + } + } + } + + if (timeout > 0) { + vwaitItems[numItems].donePtr = &timedOut; + vwaitItems[numItems].sequence = -1; + vwaitItems[numItems].mask = 0; + vwaitItems[numItems].sourceObj = NULL; + timer = Tcl_CreateTimerHandler(timeout, VwaitTimeoutProc, + &vwaitItems[numItems]); + Tcl_GetTime(&before); + } else { + timeout = 0; + } + + if ((numItems == 0) && (timeout == 0)) { + /* + * "vwait" is equivalent to "update", + * "vwait -nofileevents -notimerevents -nowindowevents" + * is equivalent to "update idletasks" + */ + any = 1; + mask |= TCL_DONT_WAIT; + } + foundEvent = 1; - while (!done && foundEvent) { - foundEvent = Tcl_DoOneEvent(TCL_ALL_EVENTS); + while (!timedOut && foundEvent && + ((!any && (done < numItems)) || (any && !done))) { + foundEvent = Tcl_DoOneEvent(mask); if (Tcl_Canceled(interp, TCL_LEAVE_ERR_MSG) == TCL_ERROR) { break; } if (Tcl_LimitExceeded(interp)) { Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_NewStringObj("limit exceeded", -1)); + Tcl_SetErrorCode(interp, "TCL", "EVENT", "LIMIT", NULL); break; } + if ((numItems == 0) && (timeout == 0)) { + /* + * Behavior like "update": clear interpreter's result because + * event handlers could have executed commands. + */ + Tcl_ResetResult(interp); + result = TCL_OK; + goto done; + } } - Tcl_UntraceVar2(interp, nameString, NULL, - TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, - VwaitVarProc, &done); if (!foundEvent) { Tcl_ResetResult(interp); - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't wait for variable \"%s\": would wait forever", - nameString)); + Tcl_SetObjResult(interp, Tcl_NewStringObj((numItems == 0) ? + "can't wait: would wait forever" : + "can't wait for variable(s)/channel(s): would wait forever", + -1)); Tcl_SetErrorCode(interp, "TCL", "EVENT", "NO_SOURCES", NULL); - return TCL_ERROR; + result = TCL_ERROR; + goto done; } - if (!done) { + + if (!done && !timedOut) { /* * The interpreter's result was already set to the right error message * prior to exiting the loop above. */ + result = TCL_ERROR; + goto done; + } - return TCL_ERROR; + result = TCL_OK; + if (timeout <= 0) { + /* + * Clear out the interpreter's result, since it may have been set + * by event handlers. + */ + Tcl_ResetResult(interp); + goto done; } /* - * Clear out the interpreter's result, since it may have been set by event - * handlers. + * When timeout was specified, report milliseconds left or -1 on timeout. */ + if (timedOut) { + diff = -1; + } else { + Tcl_GetTime(&after); + diff = after.sec * 1000 + after.usec / 1000; + diff -= before.sec * 1000 + before.usec / 1000; + diff = timeout - diff; + if (diff < 0) { + diff = 0; + } + } - Tcl_ResetResult(interp); - return TCL_OK; + done: + if ((timeout > 0) && (timer != NULL)) { + Tcl_DeleteTimerHandler(timer); + } + if (result != TCL_OK) { + saved = Tcl_SaveInterpState(interp, result); + } + for (i = 0; i < numItems; i++) { + if (vwaitItems[i].mask & TCL_READABLE) { + if (TclGetChannelFromObj(interp, vwaitItems[i].sourceObj, + &chan, &mode, 0) == TCL_OK) { + Tcl_DeleteChannelHandler(chan, VwaitChannelReadProc, + &vwaitItems[i]); + } + } else if (vwaitItems[i].mask & TCL_WRITABLE) { + if (TclGetChannelFromObj(interp, vwaitItems[i].sourceObj, + &chan, &mode, 0) == TCL_OK) { + Tcl_DeleteChannelHandler(chan, VwaitChannelWriteProc, + &vwaitItems[i]); + } + } else { + Tcl_UntraceVar2(interp, TclGetString(vwaitItems[i].sourceObj), + NULL, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, + VwaitVarProc, &vwaitItems[i]); + } + } + + if (result == TCL_OK) { + if (extended) { + int k; + Tcl_Obj *listObj, *keyObj; + + TclNewObj(listObj); + for (k = 0; k < done; k++) { + for (i = 0; i < numItems; i++) { + if (vwaitItems[i].sequence != k) { + continue; + } + if (vwaitItems[i].mask & TCL_READABLE) { + TclNewLiteralStringObj(keyObj, "readable"); + } else if (vwaitItems[i].mask & TCL_WRITABLE) { + TclNewLiteralStringObj(keyObj, "writable"); + } else { + TclNewLiteralStringObj(keyObj, "variable"); + } + Tcl_ListObjAppendElement(NULL, listObj, keyObj); + Tcl_ListObjAppendElement(NULL, listObj, + vwaitItems[i].sourceObj); + } + } + if (timeout > 0) { + TclNewLiteralStringObj(keyObj, "timeleft"); + Tcl_ListObjAppendElement(NULL, listObj, keyObj); + Tcl_ListObjAppendElement(NULL, listObj, + Tcl_NewWideIntObj(diff)); + } + Tcl_SetObjResult(interp, listObj); + } else if (timeout > 0) { + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(diff)); + } + } else { + result = Tcl_RestoreInterpState(interp, saved); + } + if (vwaitItems != localItems) { + Tcl_Free(vwaitItems); + } + return result; +} + +static void +VwaitChannelReadProc( + void *clientData, /* Pointer to vwait info record. */ + int mask) /* Event mask, must be TCL_READABLE. */ +{ + VwaitItem *itemPtr = (VwaitItem *) clientData; + + if (!(mask & TCL_READABLE)) { + return; + } + if (itemPtr->donePtr != NULL) { + itemPtr->sequence = itemPtr->donePtr[0]; + itemPtr->donePtr[0] += 1; + itemPtr->donePtr = NULL; + } +} + +static void +VwaitChannelWriteProc( + void *clientData, /* Pointer to vwait info record. */ + int mask) /* Event mask, must be TCL_WRITABLE. */ +{ + VwaitItem *itemPtr = (VwaitItem *) clientData; + + if (!(mask & TCL_WRITABLE)) { + return; + } + if (itemPtr->donePtr != NULL) { + itemPtr->sequence = itemPtr->donePtr[0]; + itemPtr->donePtr[0] += 1; + itemPtr->donePtr = NULL; + } +} + +static void +VwaitTimeoutProc( + void *clientData) /* Pointer to vwait info record. */ +{ + VwaitItem *itemPtr = (VwaitItem *) clientData; + + if (itemPtr->donePtr != NULL) { + itemPtr->donePtr[0] = 1; + itemPtr->donePtr = NULL; + } } static char * VwaitVarProc( - void *clientData, /* Pointer to integer to set to 1. */ + void *clientData, /* Pointer to vwait info record. */ Tcl_Interp *interp, /* Interpreter containing variable. */ const char *name1, /* Name of variable. */ const char *name2, /* Second part of variable name. */ TCL_UNUSED(int) /*flags*/) /* Information about what happened. */ { - int *donePtr = (int *)clientData; + VwaitItem *itemPtr = (VwaitItem *) clientData; - *donePtr = 1; + if (itemPtr->donePtr != NULL) { + itemPtr->sequence = itemPtr->donePtr[0]; + itemPtr->donePtr[0] += 1; + itemPtr->donePtr = NULL; + } Tcl_UntraceVar2(interp, name1, name2, TCL_TRACE_WRITES|TCL_TRACE_UNSETS, VwaitVarProc, clientData); return NULL; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 6db2faf..c0af4bd 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -19,6 +19,7 @@ #include "tclCompile.h" #include "tclOOInt.h" #include "tclTomMath.h" +#include "tclArithSeries.h" #include <math.h> #include <assert.h> @@ -4658,6 +4659,23 @@ TEBCresume( valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + /* special case for ArithSeries */ + if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) { + length = TclArithSeriesObjLength(valuePtr); + if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + goto lindexDone; + } + /* * Extract the desired list element. */ @@ -4679,6 +4697,8 @@ TEBCresume( } objResultPtr = TclLindexList(interp, valuePtr, value2Ptr); + + lindexDone: if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; @@ -4702,6 +4722,28 @@ TEBCresume( opnd = TclGetInt4AtPtr(pc+1); TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd)); + /* special case for ArithSeries */ + if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) { + length = TclArithSeriesObjLength(valuePtr); + + /* Decode end-offset index values. */ + + index = TclIndexDecode(opnd, length); + + /* Compute value @ index */ + if (index < length) { + if (TclArithSeriesObjIndex(valuePtr, index, &objResultPtr) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + } else { + TclNewObj(objResultPtr); + } + pcAdjustment = 5; + goto lindexFastPath2; + } + /* * Get the contents of the list, making sure that it really is a list * in the process. @@ -4724,6 +4766,8 @@ TEBCresume( TclNewObj(objResultPtr); } + lindexFastPath2: + TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr))); NEXT_INST_F(pcAdjustment, 1, 1); @@ -4899,7 +4943,11 @@ TEBCresume( fromIdx = TclIndexDecode(fromIdx, objc - 1); - objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); + if (TclHasInternalRep(valuePtr,&tclArithSeriesType)) { + objResultPtr = TclArithSeriesObjRange(valuePtr, fromIdx, toIdx); + } else { + objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); + } TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr))); NEXT_INST_F(9, 1, 1); @@ -4919,7 +4967,7 @@ TEBCresume( if (length > 0) { size_t i = 0; Tcl_Obj *o; - + int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType); /* * An empty list doesn't match anything. */ @@ -4935,6 +4983,9 @@ TEBCresume( if (s1len == s2len) { match = (memcmp(s1, s2, s1len) == 0); } + if (isArithSeries) { + TclDecrRefCount(o); + } i++; } while (i < length && match == 0); } diff --git a/generic/tclIO.c b/generic/tclIO.c index aeed4cd..3549317 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -1655,6 +1655,7 @@ Tcl_CreateChannel( } statePtr->channelName = tmp; statePtr->flags = mask; + statePtr->maxPerms = mask; /* Save max privileges for close callback */ /* * Set the channel to system default encoding. @@ -2140,8 +2141,11 @@ Tcl_UnstackChannel( /* * Close and free the channel driver state. + * TIP #220: This is done with maximum privileges (as created). */ + statePtr->flags &= ~(TCL_READABLE|TCL_WRITABLE); + statePtr->flags |= statePtr->maxPerms; result = ChanClose(chanPtr, interp); ChannelFree(chanPtr); @@ -2421,6 +2425,54 @@ Tcl_GetChannelHandle( } /* + *---------------------------------------------------------------------- + * + * Tcl_RemoveChannelMode -- + * + * Remove either read or write privileges from the channel. + * + * Results: + * A standard Tcl result code. + * + * Side effects: + * May change the access mode of the channel. + * May leave an error message in the interp. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RemoveChannelMode( + Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Channel chan, /* The channel which is modified. */ + int mode) /* The access mode to drop from the channel */ +{ + const char* emsg; + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of actual channel. */ + + if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { + emsg = "Illegal mode value."; + goto error; + } + if (0 == (statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & ~mode)) { + emsg = "Bad mode, would make channel inacessible"; + goto error; + } + + statePtr->flags &= ~mode; + return TCL_OK; + + error: + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Tcl_RemoveChannelMode error: %s. Channel: \"%s\"", + emsg, Tcl_GetChannelName((Tcl_Channel) chan))); + } + return TCL_ERROR; +} + +/* *--------------------------------------------------------------------------- * * AllocChannelBuffer -- diff --git a/generic/tclIO.h b/generic/tclIO.h index ca6a0ac..e5a3b7b 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -216,6 +216,8 @@ typedef struct ChannelState { * companion to 'unreportedError'. */ size_t epoch; /* Used to test validity of stored channelname * lookup results. */ + int maxPerms; /* TIP #220: Max access privileges + * the channel was created with. */ } ChannelState; /* diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 2c6c0f8..1bd462d 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -37,6 +37,11 @@ declare 6 { declare 7 { Tcl_Size TclCopyAndCollapse(Tcl_Size count, const char *src, char *dst) } +# Removed in 9.0: +#declare 8 { +# int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan, +# Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr) +#} # TclCreatePipeline unofficially exported for use by BLT. declare 9 { Tcl_Size TclCreatePipeline(Tcl_Interp *interp, Tcl_Size argc, const char **argv, @@ -85,6 +90,14 @@ declare 32 { int TclGetFrame(Tcl_Interp *interp, const char *str, CallFrame **framePtrPtr) } +# Removed in 9.0: +#declare 34 { +# int TclGetIntForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr, +# int endValue, int *indexPtr) +#} +#declare 37 { +# int TclGetLoadedPackages(Tcl_Interp *interp, const char *targetName) +#} declare 38 { int TclGetNamespaceForQualName(Tcl_Interp *interp, const char *qualName, Namespace *cxtNsPtr, int flags, Namespace **nsPtrPtr, @@ -103,12 +116,24 @@ declare 41 { declare 42 { const char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr) } +declare 43 { + Tcl_ObjCmdProc2 *TclGetObjInterpProc2(void) +} +# Removed in 9.0: +#declare 44 { +# int TclGuessPackageName(const char *fileName, Tcl_DString *bufPtr) +#} declare 45 { int TclHideUnsafeCommands(Tcl_Interp *interp) } declare 46 { int TclInExit(void) } +# Removed in 9.0: +#declare 50 { +# void TclInitCompiledLocals(Tcl_Interp *interp, CallFrame *framePtr, +# Namespace *nsPtr) +#} declare 51 { int TclInterpInit(Tcl_Interp *interp) } @@ -157,9 +182,18 @@ declare 75 { declare 76 { unsigned long long TclpGetSeconds(void) } +# Removed in 9.0: +#declare 77 { +# void TclpGetTime(Tcl_Time *time) +#} declare 81 { void *TclpRealloc(void *ptr, TCL_HASH_TYPE size) } +# Removed in 9.0: +#declare 88 { +# char *TclPrecTraceProc(void *clientData, Tcl_Interp *interp, +# const char *name1, const char *name2, int flags) +#} declare 89 { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd) @@ -196,6 +230,10 @@ declare 103 { int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto, int *portPtr) } +# Removed in 9.0: +#declare 104 { +# int TclSockMinimumBuffersOld(int sock, int size) +#} declare 108 { void TclTeardownNamespace(Namespace *nsPtr) } @@ -205,10 +243,6 @@ declare 109 { declare 110 { int TclSockMinimumBuffers(void *sock, Tcl_Size size) } -# Removed in 8.1: -# declare 110 { -# char *TclWordEnd(char *start, char *lastChar, int nested, int *semiPtr) -# } # Procedures used in conjunction with Tcl namespaces. They are # defined here instead of in tcl.decls since they are not stable yet. @@ -218,6 +252,30 @@ declare 111 { Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc) } +# Removed in 9.0: +#declare 112 { +# int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# Tcl_Obj *objPtr) +#} +#declare 113 { +# Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name, +# void *clientData, Tcl_NamespaceDeleteProc *deleteProc) +#} +#declare 114 { +# void TclDeleteNamespace(Tcl_Namespace *nsPtr) +#} +#declare 115 { +# int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int resetListFirst) +#} +#declare 116 { +# Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} +#declare 117 { +# Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name, +# Tcl_Namespace *contextNsPtr, int flags) +#} declare 118 { int Tcl_GetInterpResolvers(Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo) @@ -230,10 +288,33 @@ declare 120 { Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags) } +# Removed in 9.0: +#declare 121 { +# int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern) +#} +#declare 122 { +# Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr) +#} +#declare 123 { +# void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command, +# Tcl_Obj *objPtr) +#} +#declare 124 { +# Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp) +#} +#declare 125 { +# Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp) +#} declare 126 { void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr) } +# Removed in 9.0: +#declare 127 { +# int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr, +# const char *pattern, int allowOverwrite) +#} declare 128 { void Tcl_PopCallFrame(Tcl_Interp *interp) } @@ -252,6 +333,10 @@ declare 131 { declare 132 { int TclpHasSockets(Tcl_Interp *interp) } +# Removed in 9.0: +#declare 133 { +# struct tm *TclpGetDate(const time_t *time, int useGMT) +#} declare 138 { const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } @@ -306,6 +391,14 @@ declare 156 { declare 157 { Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName) } +# Removed in 9.0: +#declare 158 { +# void TclSetStartupScriptFileName(const char *filename) +#} +#declare 159 { +# const char *TclGetStartupScriptFileName(void) +#} + declare 161 { int TclChannelTransform(Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr) @@ -342,6 +435,13 @@ declare 166 { Tcl_Size index, Tcl_Obj *valuePtr) } +# Removed in 9.0: +#declare 167 { +# void TclSetStartupScriptPath(Tcl_Obj *pathPtr) +#} +#declare 168 { +# Tcl_Obj *TclGetStartupScriptPath(void) +#} # variant of Tcl_UtfNCmp that takes n as bytes, not chars declare 169 { int TclpUtfNcmp2(const char *s1, const char *s2, size_t n) @@ -374,6 +474,22 @@ declare 177 { void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason) } +# Removed in 9.0: +#declare 178 { +# void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName) +#} +#declare 179 { +# Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr) +#} +#declare 182 { +# struct tm *TclpLocaltime(const time_t *clock) +#} +#declare 183 { +# struct tm *TclpGmtime(const time_t *clock) +#} + +# For the new "Thread Storage" subsystem. + declare 198 { int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr) @@ -478,6 +594,10 @@ declare 234 { declare 235 { void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr) } +# Removed in 9.0: +#declare 236 { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 { @@ -583,7 +703,6 @@ declare 258 { Tcl_Obj *basenameObj) } - # TIP 625: for unit testing - create list objects with span declare 260 { Tcl_Obj *TclListTestObj(int length, int leadingSpace, int endSpace) @@ -593,7 +712,6 @@ declare 260 { declare 261 { void TclListObjValidate(Tcl_Interp *interp, Tcl_Obj *listObj) } - ############################################################################## diff --git a/generic/tclInt.h b/generic/tclInt.h index dee9f30..3c12081 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2878,6 +2878,7 @@ MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; +MODULE_SCOPE const Tcl_ObjType tclArithSeriesType; MODULE_SCOPE const Tcl_ObjType tclDictType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; @@ -3230,6 +3231,7 @@ MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name, const EnsembleImplMap map[]); +MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp); MODULE_SCOPE int TclMaxListLength(const char *bytes, Tcl_Size numBytes, const char **endPtr); MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, @@ -3636,6 +3638,9 @@ MODULE_SCOPE int Tcl_LreverseObjCmd(void *clientData, MODULE_SCOPE int Tcl_LsearchObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +MODULE_SCOPE int Tcl_LseqObjCmd(void *clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); MODULE_SCOPE int Tcl_LsetObjCmd(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 9332b5e..b84b996 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -130,7 +130,8 @@ EXTERN Tcl_Command TclGetOriginalCommand(Tcl_Command command); /* 42 */ EXTERN const char * TclpGetUserHome(const char *name, Tcl_DString *bufferPtr); -/* Slot 43 is reserved */ +/* 43 */ +EXTERN Tcl_ObjCmdProc2 * TclGetObjInterpProc2(void); /* Slot 44 is reserved */ /* 45 */ EXTERN int TclHideUnsafeCommands(Tcl_Interp *interp); @@ -631,7 +632,7 @@ typedef struct TclIntStubs { int (*tclGetOpenMode) (Tcl_Interp *interp, const char *str, int *seekFlagPtr); /* 40 */ Tcl_Command (*tclGetOriginalCommand) (Tcl_Command command); /* 41 */ const char * (*tclpGetUserHome) (const char *name, Tcl_DString *bufferPtr); /* 42 */ - void (*reserved43)(void); + Tcl_ObjCmdProc2 * (*tclGetObjInterpProc2) (void); /* 43 */ void (*reserved44)(void); int (*tclHideUnsafeCommands) (Tcl_Interp *interp); /* 45 */ int (*tclInExit) (void); /* 46 */ @@ -929,7 +930,8 @@ extern const TclIntStubs *tclIntStubsPtr; (tclIntStubsPtr->tclGetOriginalCommand) /* 41 */ #define TclpGetUserHome \ (tclIntStubsPtr->tclpGetUserHome) /* 42 */ -/* Slot 43 is reserved */ +#define TclGetObjInterpProc2 \ + (tclIntStubsPtr->tclGetObjInterpProc2) /* 43 */ /* Slot 44 is reserved */ #define TclHideUnsafeCommands \ (tclIntStubsPtr->tclHideUnsafeCommands) /* 45 */ @@ -1291,6 +1293,7 @@ extern const TclIntStubs *tclIntStubsPtr; #undef TclObjInterpProc #define TclObjInterpProc TclGetObjInterpProc() +#define TclObjInterpProc2 TclGetObjInterpProc2() #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 589b0da..98e63db 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2481,7 +2481,7 @@ ChildCreate( ((Interp *) parentInterp)->maxNestingDepth; if (safe) { - if (Tcl_MakeSafe(childInterp) == TCL_ERROR) { + if (TclMakeSafe(childInterp) == TCL_ERROR) { goto error; } } else { @@ -3264,7 +3264,7 @@ Tcl_IsSafe( /* *---------------------------------------------------------------------- * - * Tcl_MakeSafe -- + * TclMakeSafe -- * * Makes its argument interpreter contain only functionality that is * defined to be part of Safe Tcl. Unsafe commands are hidden, the env @@ -3281,7 +3281,7 @@ Tcl_IsSafe( */ int -Tcl_MakeSafe( +TclMakeSafe( Tcl_Interp *interp) /* Interpreter to be made safe. */ { Tcl_Channel chan; /* Channel to remove from safe interpreter. */ diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 163f831..0ded8df 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -9,8 +9,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include "tclInt.h" #include <assert.h> +#include "tclInt.h" +#include "tclArithSeries.h" /* * TODO - memmove is fast. Measure at what size we should prefer memmove @@ -1658,6 +1659,10 @@ Tcl_ListObjGetElements( { ListRep listRep; + if (TclHasInternalRep(objPtr,&tclArithSeriesType)) { + return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr); + } + if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) return TCL_ERROR; ListRepElements(&listRep, *objcPtr, *objvPtr); @@ -1933,6 +1938,10 @@ Tcl_ListObjIndex( Tcl_Obj **elemObjs; Tcl_Size numElems; + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + return TclArithSeriesObjIndex(listObj, index, objPtrPtr); + } + /* * TODO * Unlike the original list code, this does not optimize for lindex'ing @@ -1963,7 +1972,7 @@ Tcl_ListObjIndex( * convert it to one. * * Results: - * The return value is normally TCL_OK; in this case *intPtr will be set + * The return value is normally TCL_OK; in this case *lenPtr will be set * to the integer count of list elements. If listPtr does not refer to a * list object and the object can not be converted to one, TCL_ERROR is * returned and an error message will be left in the interpreter's result @@ -1984,6 +1993,11 @@ Tcl_ListObjLength( { ListRep listRep; + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + *lenPtr = TclArithSeriesObjLength(listObj); + return TCL_OK; + } + /* * TODO * Unlike the original list code, this does not optimize for lindex'ing @@ -2611,6 +2625,27 @@ TclLindexFlat( { Tcl_Size i; + /* Handle ArithSeries as special case */ + if (TclHasInternalRep(listObj,&tclArithSeriesType)) { + ListSizeT index, listLen = TclArithSeriesObjLength(listObj); + Tcl_Obj *elemObj = NULL; + for (i=0 ; i<indexCount && listObj ; i++) { + if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1, + &index) == TCL_OK) { + } + if (i==0) { + TclArithSeriesObjIndex(listObj, index, &elemObj); + Tcl_IncrRefCount(elemObj); + } else if (index > 0) { + Tcl_DecrRefCount(elemObj); + TclNewObj(elemObj); + Tcl_IncrRefCount(elemObj); + break; + } + } + return elemObj; + } + Tcl_IncrRefCount(listObj); for (i=0 ; i<indexCount && listObj ; i++) { @@ -3238,6 +3273,34 @@ SetListFromAny( Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } + } else if (TclHasInternalRep(objPtr,&tclArithSeriesType)) { + /* + * Convertion from Arithmetic Series is a special case + * because it can be done an order of magnitude faster + * and may occur frequently. + */ + ListSizeT j, size = TclArithSeriesObjLength(objPtr); + + /* TODO - leave space in front and/or back? */ + if (ListRepInitAttempt( + interp, size > 0 ? size : 1, NULL, &listRep) + != TCL_OK) { + return TCL_ERROR; + } + + LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */ + LIST_ASSERT(listRep.storePtr->firstUsed == 0); + LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0); + + listRep.storePtr->numUsed = size; + elemPtrs = listRep.storePtr->slots; + for (j = 0; j < size; j++) { + if (TclArithSeriesObjIndex(objPtr, j, &elemPtrs[j]) != TCL_OK) { + return TCL_ERROR; + } + Tcl_IncrRefCount(elemPtrs[j]);/* Since list now holds ref to it. */ + } + } else { Tcl_Size estCount, length; const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length); @@ -3424,6 +3487,7 @@ UpdateStringOfList( Tcl_Free(flagPtr); } } + /* *------------------------------------------------------------------------ diff --git a/generic/tclProc.c b/generic/tclProc.c index 4d421c7..acb520c 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -485,7 +485,7 @@ TclCreateProc( * in the Proc. */ - result = TclListObjGetElementsM(interp , argsPtr ,&numArgs ,&argArray); + result = TclListObjGetElementsM(interp, argsPtr, &numArgs, &argArray); if (result != TCL_OK) { goto procError; } @@ -576,7 +576,7 @@ TclCreateProc( * (its value was kept the same as pre VarReform to simplify * tbcload's processing of older byetcodes). * - * The only other flag vlaue that is important to retrieve from + * The only other flag value that is important to retrieve from * precompiled procs is VAR_TEMPORARY (also unchanged). It is * needed later when retrieving the variable names. */ @@ -1085,7 +1085,7 @@ ProcWrongNumArgs( Tcl_IncrRefCount(desiredObjs[0]); if (localCt > 0) { - Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt); + Var *defPtr = (Var *)(&framePtr->localCachePtr->varName0 + localCt); for (i=1 ; i<=numArgs ; i++, defPtr++) { Tcl_Obj *argObj; @@ -1595,7 +1595,6 @@ TclPushProcCallFrame( *---------------------------------------------------------------------- */ -#undef TclObjInterpProc int TclObjInterpProc( ClientData clientData, /* Record describing procedure to be @@ -1631,6 +1630,43 @@ TclNRInterpProc( } return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); } + +static int +NRInterpProc2( + ClientData clientData, /* Record describing procedure to be + * interpreted. */ + Tcl_Interp *interp,/* Interpreter in which procedure was + * invoked. */ + size_t objc, /* Count of number of arguments to this + * procedure. */ + Tcl_Obj *const objv[]) /* Argument value objects. */ +{ + int result = TclPushProcCallFrame(clientData, interp, objc, objv, + /*isLambda*/ 0); + + if (result != TCL_OK) { + return TCL_ERROR; + } + return TclNRInterpProcCore(interp, objv[0], 1, &MakeProcError); +} + +static int +ObjInterpProc2( + ClientData clientData, /* Record describing procedure to be + * interpreted. */ + Tcl_Interp *interp,/* Interpreter in which procedure was + * invoked. */ + size_t objc, /* Count of number of arguments to this + * procedure. */ + Tcl_Obj *const objv[]) /* Argument value objects. */ +{ + /* + * Not used much in the core; external interface for iTcl + */ + + return Tcl_NRCallObjProc2(interp, NRInterpProc2, clientData, objc, objv); +} + /* *---------------------------------------------------------------------- @@ -2224,15 +2260,16 @@ TclUpdateReturnInfo( /* *---------------------------------------------------------------------- * - * TclGetObjInterpProc -- + * TclGetObjInterpProc/TclGetObjInterpProc2 -- * - * Returns a pointer to the TclObjInterpProc function; this is different - * from the value obtained from the TclObjInterpProc reference on systems - * like Windows where import and export versions of a function exported - * by a DLL exist. + * Returns a pointer to the TclObjInterpProc/ObjInterpProc2 functions; + * this is different from the value obtained from the TclObjInterpProc + * reference on systems like Windows where import and export versions + * of a function exported by a DLL exist. * * Results: - * Returns the internal address of the TclObjInterpProc function. + * Returns the internal address of the TclObjInterpProc/ObjInterpProc2 + * functions. * * Side effects: * None. @@ -2245,6 +2282,12 @@ TclGetObjInterpProc(void) { return TclObjInterpProc; } + +Tcl_ObjCmdProc2 * +TclGetObjInterpProc2(void) +{ + return ObjInterpProc2; +} /* *---------------------------------------------------------------------- diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index c7d7d70..cf23aab 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -731,7 +731,9 @@ Tcl_GetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. + * String object, convert it to one. If first is TCL_INDEX_NONE, the + * returned string start at the beginning of objPtr. If last is + * TCL_INDEX_NONE, the returned string ends at the end of objPtr. * * Results: * Returns a new Tcl Object of the String type. diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index a00e835..2928cfa 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -435,7 +435,7 @@ static const TclIntStubs tclIntStubs = { TclGetOpenMode, /* 40 */ TclGetOriginalCommand, /* 41 */ TclpGetUserHome, /* 42 */ - 0, /* 43 */ + TclGetObjInterpProc2, /* 43 */ 0, /* 44 */ TclHideUnsafeCommands, /* 45 */ TclInExit, /* 46 */ @@ -986,7 +986,7 @@ const TclStubs tclStubs = { Tcl_LinkVar, /* 187 */ 0, /* 188 */ Tcl_MakeFileChannel, /* 189 */ - Tcl_MakeSafe, /* 190 */ + 0, /* 190 */ Tcl_MakeTcpClientChannel, /* 191 */ Tcl_Merge, /* 192 */ Tcl_NextHashEntry, /* 193 */ @@ -1476,6 +1476,9 @@ const TclStubs tclStubs = { Tcl_CreateObjTrace2, /* 677 */ Tcl_NRCreateCommand2, /* 678 */ Tcl_NRCallObjProc2, /* 679 */ + 0, /* 680 */ + 0, /* 681 */ + Tcl_RemoveChannelMode, /* 682 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index ce83500..57037c2 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -170,6 +170,15 @@ typedef struct TestChannel { static TestChannel *firstDetached; +#ifdef __GNUC__ +/* + * The rest of this file shouldn't warn about deprecated functions; they're + * there because we intend them to be so and know that this file is OK to + * touch those fields. + */ +#pragma GCC diagnostic ignored "-Wdeprecated-declarations" +#endif + /* * Forward declarations for procedures defined later in this file: */ @@ -6000,6 +6009,45 @@ TestChannelCmd( return TCL_OK; } + if ((cmdName[0] == 'm') && (strncmp(cmdName, "maxmode", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", NULL); + return TCL_ERROR; + } + + if (statePtr->maxPerms & TCL_READABLE) { + Tcl_AppendElement(interp, "read"); + } else { + Tcl_AppendElement(interp, ""); + } + if (statePtr->maxPerms & TCL_WRITABLE) { + Tcl_AppendElement(interp, "write"); + } else { + Tcl_AppendElement(interp, ""); + } + return TCL_OK; + } + + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-rd", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + return Tcl_RemoveChannelMode(interp, chan, TCL_READABLE); + } + + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-wr", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + return Tcl_RemoveChannelMode(interp, chan, TCL_WRITABLE); + } + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls index 9c5ca8b..d9335c5 100644 --- a/generic/tclTomMath.decls +++ b/generic/tclTomMath.decls @@ -74,7 +74,7 @@ declare 16 { mp_err MP_WUR TclBN_mp_div_2d(const mp_int *a, int b, mp_int *q, mp_int *r) } # Removed in 9.0 -#declare 17 {deprecated {is private function in libtommath}} { +#declare 17 { # mp_err TclBN_mp_div_3(const mp_int *a, mp_int *q, mp_digit *r) #} declare 18 { @@ -141,7 +141,7 @@ declare 38 { mp_err MP_WUR TclBN_mp_shrink(mp_int *a) } # Removed in 9.0 -#declare 39 {deprecated {macro calling mp_set_u64}} { +#declare 39 { # void TclBN_mp_set(mp_int *a, unsigned int b) #} # Removed in 9.0 @@ -180,18 +180,18 @@ declare 49 { void TclBN_mp_zero(mp_int *a) } # Removed in 9.0 -#declare 61 {deprecated {macro calling mp_init_u64}} { +#declare 61 { # mp_err TclBN_mp_init_ul(mp_int *a, unsigned long i) #} # Removed in 9.0 -#declare 62 {deprecated {macro calling mp_set_u64}} { +#declare 62 { # void TclBN_mp_set_ul(mp_int *a, unsigned long i) #} declare 63 { int MP_WUR TclBN_mp_cnt_lsb(const mp_int *a) } # Removed in 9.0 -#declare 64 {deprecated {macro calling mp_init_i64}} { +#declare 64 { # int TclBN_mp_init_l(mp_int *bignum, long initVal) #} declare 65 { diff --git a/library/safe.tcl b/library/safe.tcl index c082c33..0cf891e 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -524,8 +524,6 @@ proc ::safe::InterpInit { ::interp alias $child ::tcl::info::nameofexecutable {} \ ::safe::AliasExeName $child - # The allowed child variables already have been set by Tcl_MakeSafe(3) - # Source init.tcl and tm.tcl into the child, to get auto_load and # other procedures defined: diff --git a/library/tzdata/Asia/Gaza b/library/tzdata/Asia/Gaza index e819d87..1ceb680 100644 --- a/library/tzdata/Asia/Gaza +++ b/library/tzdata/Asia/Gaza @@ -126,159 +126,159 @@ set TZData(:Asia/Gaza) { {1616796000 10800 1 EEST} {1635458400 7200 0 EET} {1648332000 10800 1 EEST} - {1666908000 7200 0 EET} - {1679781600 10800 1 EEST} - {1698357600 7200 0 EET} - {1711836000 10800 1 EEST} - {1729807200 7200 0 EET} - {1743285600 10800 1 EEST} - {1761256800 7200 0 EET} - {1774735200 10800 1 EEST} - {1792706400 7200 0 EET} - {1806184800 10800 1 EEST} - {1824760800 7200 0 EET} - {1837634400 10800 1 EEST} - {1856210400 7200 0 EET} - {1869084000 10800 1 EEST} - {1887660000 7200 0 EET} - {1901138400 10800 1 EEST} - {1919109600 7200 0 EET} - {1932588000 10800 1 EEST} - {1950559200 7200 0 EET} - {1964037600 10800 1 EEST} - {1982613600 7200 0 EET} - {1995487200 10800 1 EEST} - {2014063200 7200 0 EET} - {2026936800 10800 1 EEST} - {2045512800 7200 0 EET} - {2058386400 10800 1 EEST} - {2076962400 7200 0 EET} - {2090440800 10800 1 EEST} - {2108412000 7200 0 EET} - {2121890400 10800 1 EEST} - {2139861600 7200 0 EET} - {2153340000 10800 1 EEST} - {2171916000 7200 0 EET} - {2184789600 10800 1 EEST} - {2203365600 7200 0 EET} - {2216239200 10800 1 EEST} - {2234815200 7200 0 EET} - {2248293600 10800 1 EEST} - {2266264800 7200 0 EET} - {2279743200 10800 1 EEST} - {2297714400 7200 0 EET} - {2311192800 10800 1 EEST} - {2329164000 7200 0 EET} - {2342642400 10800 1 EEST} - {2361218400 7200 0 EET} - {2374092000 10800 1 EEST} - {2392668000 7200 0 EET} - {2405541600 10800 1 EEST} - {2424117600 7200 0 EET} - {2437596000 10800 1 EEST} - {2455567200 7200 0 EET} - {2469045600 10800 1 EEST} - {2487016800 7200 0 EET} - {2500495200 10800 1 EEST} - {2519071200 7200 0 EET} - {2531944800 10800 1 EEST} - {2550520800 7200 0 EET} - {2563394400 10800 1 EEST} - {2581970400 7200 0 EET} - {2595448800 10800 1 EEST} - {2613420000 7200 0 EET} - {2626898400 10800 1 EEST} - {2644869600 7200 0 EET} - {2658348000 10800 1 EEST} - {2676319200 7200 0 EET} - {2689797600 10800 1 EEST} - {2708373600 7200 0 EET} - {2721247200 10800 1 EEST} - {2739823200 7200 0 EET} - {2752696800 10800 1 EEST} - {2771272800 7200 0 EET} - {2784751200 10800 1 EEST} - {2802722400 7200 0 EET} - {2816200800 10800 1 EEST} - {2834172000 7200 0 EET} - {2847650400 10800 1 EEST} - {2866226400 7200 0 EET} - {2879100000 10800 1 EEST} - {2897676000 7200 0 EET} - {2910549600 10800 1 EEST} - {2929125600 7200 0 EET} - {2941999200 10800 1 EEST} - {2960575200 7200 0 EET} - {2974053600 10800 1 EEST} - {2992024800 7200 0 EET} - {3005503200 10800 1 EEST} - {3023474400 7200 0 EET} - {3036952800 10800 1 EEST} - {3055528800 7200 0 EET} - {3068402400 10800 1 EEST} - {3086978400 7200 0 EET} - {3099852000 10800 1 EEST} - {3118428000 7200 0 EET} - {3131906400 10800 1 EEST} - {3149877600 7200 0 EET} - {3163356000 10800 1 EEST} - {3181327200 7200 0 EET} - {3194805600 10800 1 EEST} - {3212776800 7200 0 EET} - {3226255200 10800 1 EEST} - {3244831200 7200 0 EET} - {3257704800 10800 1 EEST} - {3276280800 7200 0 EET} - {3289154400 10800 1 EEST} - {3307730400 7200 0 EET} - {3321208800 10800 1 EEST} - {3339180000 7200 0 EET} - {3352658400 10800 1 EEST} - {3370629600 7200 0 EET} - {3384108000 10800 1 EEST} - {3402684000 7200 0 EET} - {3415557600 10800 1 EEST} - {3434133600 7200 0 EET} - {3447007200 10800 1 EEST} - {3465583200 7200 0 EET} - {3479061600 10800 1 EEST} - {3497032800 7200 0 EET} - {3510511200 10800 1 EEST} - {3528482400 7200 0 EET} - {3541960800 10800 1 EEST} - {3559932000 7200 0 EET} - {3573410400 10800 1 EEST} - {3591986400 7200 0 EET} - {3604860000 10800 1 EEST} - {3623436000 7200 0 EET} - {3636309600 10800 1 EEST} - {3654885600 7200 0 EET} - {3668364000 10800 1 EEST} - {3686335200 7200 0 EET} - {3699813600 10800 1 EEST} - {3717784800 7200 0 EET} - {3731263200 10800 1 EEST} - {3749839200 7200 0 EET} - {3762712800 10800 1 EEST} - {3781288800 7200 0 EET} - {3794162400 10800 1 EEST} - {3812738400 7200 0 EET} - {3825612000 10800 1 EEST} - {3844188000 7200 0 EET} - {3857666400 10800 1 EEST} - {3875637600 7200 0 EET} - {3889116000 10800 1 EEST} - {3907087200 7200 0 EET} - {3920565600 10800 1 EEST} - {3939141600 7200 0 EET} - {3952015200 10800 1 EEST} - {3970591200 7200 0 EET} - {3983464800 10800 1 EEST} - {4002040800 7200 0 EET} - {4015519200 10800 1 EEST} - {4033490400 7200 0 EET} - {4046968800 10800 1 EEST} - {4064940000 7200 0 EET} - {4078418400 10800 1 EEST} - {4096389600 7200 0 EET} + {1666998000 7200 0 EET} + {1679702400 10800 1 EEST} + {1698447600 7200 0 EET} + {1711756800 10800 1 EEST} + {1729897200 7200 0 EET} + {1743206400 10800 1 EEST} + {1761346800 7200 0 EET} + {1774656000 10800 1 EEST} + {1792796400 7200 0 EET} + {1806105600 10800 1 EEST} + {1824850800 7200 0 EET} + {1837555200 10800 1 EEST} + {1856300400 7200 0 EET} + {1869004800 10800 1 EEST} + {1887750000 7200 0 EET} + {1901059200 10800 1 EEST} + {1919199600 7200 0 EET} + {1932508800 10800 1 EEST} + {1950649200 7200 0 EET} + {1963958400 10800 1 EEST} + {1982703600 7200 0 EET} + {1995408000 10800 1 EEST} + {2014153200 7200 0 EET} + {2026857600 10800 1 EEST} + {2045602800 7200 0 EET} + {2058307200 10800 1 EEST} + {2077052400 7200 0 EET} + {2090361600 10800 1 EEST} + {2108502000 7200 0 EET} + {2121811200 10800 1 EEST} + {2139951600 7200 0 EET} + {2153260800 10800 1 EEST} + {2172006000 7200 0 EET} + {2184710400 10800 1 EEST} + {2203455600 7200 0 EET} + {2216160000 10800 1 EEST} + {2234905200 7200 0 EET} + {2248214400 10800 1 EEST} + {2266354800 7200 0 EET} + {2279664000 10800 1 EEST} + {2297804400 7200 0 EET} + {2311113600 10800 1 EEST} + {2329254000 7200 0 EET} + {2342563200 10800 1 EEST} + {2361308400 7200 0 EET} + {2374012800 10800 1 EEST} + {2392758000 7200 0 EET} + {2405462400 10800 1 EEST} + {2424207600 7200 0 EET} + {2437516800 10800 1 EEST} + {2455657200 7200 0 EET} + {2468966400 10800 1 EEST} + {2487106800 7200 0 EET} + {2500416000 10800 1 EEST} + {2519161200 7200 0 EET} + {2531865600 10800 1 EEST} + {2550610800 7200 0 EET} + {2563315200 10800 1 EEST} + {2582060400 7200 0 EET} + {2595369600 10800 1 EEST} + {2613510000 7200 0 EET} + {2626819200 10800 1 EEST} + {2644959600 7200 0 EET} + {2658268800 10800 1 EEST} + {2676409200 7200 0 EET} + {2689718400 10800 1 EEST} + {2708463600 7200 0 EET} + {2721168000 10800 1 EEST} + {2739913200 7200 0 EET} + {2752617600 10800 1 EEST} + {2771362800 7200 0 EET} + {2784672000 10800 1 EEST} + {2802812400 7200 0 EET} + {2816121600 10800 1 EEST} + {2834262000 7200 0 EET} + {2847571200 10800 1 EEST} + {2866316400 7200 0 EET} + {2879020800 10800 1 EEST} + {2897766000 7200 0 EET} + {2910470400 10800 1 EEST} + {2929215600 7200 0 EET} + {2941920000 10800 1 EEST} + {2960665200 7200 0 EET} + {2973974400 10800 1 EEST} + {2992114800 7200 0 EET} + {3005424000 10800 1 EEST} + {3023564400 7200 0 EET} + {3036873600 10800 1 EEST} + {3055618800 7200 0 EET} + {3068323200 10800 1 EEST} + {3087068400 7200 0 EET} + {3099772800 10800 1 EEST} + {3118518000 7200 0 EET} + {3131827200 10800 1 EEST} + {3149967600 7200 0 EET} + {3163276800 10800 1 EEST} + {3181417200 7200 0 EET} + {3194726400 10800 1 EEST} + {3212866800 7200 0 EET} + {3226176000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} + {3339270000 7200 0 EET} + {3352579200 10800 1 EEST} + {3370719600 7200 0 EET} + {3384028800 10800 1 EEST} + {3402774000 7200 0 EET} + {3415478400 10800 1 EEST} + {3434223600 7200 0 EET} + {3446928000 10800 1 EEST} + {3465673200 7200 0 EET} + {3478982400 10800 1 EEST} + {3497122800 7200 0 EET} + {3510432000 10800 1 EEST} + {3528572400 7200 0 EET} + {3541881600 10800 1 EEST} + {3560022000 7200 0 EET} + {3573331200 10800 1 EEST} + {3592076400 7200 0 EET} + {3604780800 10800 1 EEST} + {3623526000 7200 0 EET} + {3636230400 10800 1 EEST} + {3654975600 7200 0 EET} + {3668284800 10800 1 EEST} + {3686425200 7200 0 EET} + {3699734400 10800 1 EEST} + {3717874800 7200 0 EET} + {3731184000 10800 1 EEST} + {3749929200 7200 0 EET} + {3762633600 10800 1 EEST} + {3781378800 7200 0 EET} + {3794083200 10800 1 EEST} + {3812828400 7200 0 EET} + {3825532800 10800 1 EEST} + {3844278000 7200 0 EET} + {3857587200 10800 1 EEST} + {3875727600 7200 0 EET} + {3889036800 10800 1 EEST} + {3907177200 7200 0 EET} + {3920486400 10800 1 EEST} + {3939231600 7200 0 EET} + {3951936000 10800 1 EEST} + {3970681200 7200 0 EET} + {3983385600 10800 1 EEST} + {4002130800 7200 0 EET} + {4015440000 10800 1 EEST} + {4033580400 7200 0 EET} + {4046889600 10800 1 EEST} + {4065030000 7200 0 EET} + {4078339200 10800 1 EEST} + {4096479600 7200 0 EET} } diff --git a/library/tzdata/Asia/Hebron b/library/tzdata/Asia/Hebron index b484c6f..b92db8d 100644 --- a/library/tzdata/Asia/Hebron +++ b/library/tzdata/Asia/Hebron @@ -125,159 +125,159 @@ set TZData(:Asia/Hebron) { {1616796000 10800 1 EEST} {1635458400 7200 0 EET} {1648332000 10800 1 EEST} - {1666908000 7200 0 EET} - {1679781600 10800 1 EEST} - {1698357600 7200 0 EET} - {1711836000 10800 1 EEST} - {1729807200 7200 0 EET} - {1743285600 10800 1 EEST} - {1761256800 7200 0 EET} - {1774735200 10800 1 EEST} - {1792706400 7200 0 EET} - {1806184800 10800 1 EEST} - {1824760800 7200 0 EET} - {1837634400 10800 1 EEST} - {1856210400 7200 0 EET} - {1869084000 10800 1 EEST} - {1887660000 7200 0 EET} - {1901138400 10800 1 EEST} - {1919109600 7200 0 EET} - {1932588000 10800 1 EEST} - {1950559200 7200 0 EET} - {1964037600 10800 1 EEST} - {1982613600 7200 0 EET} - {1995487200 10800 1 EEST} - {2014063200 7200 0 EET} - {2026936800 10800 1 EEST} - {2045512800 7200 0 EET} - {2058386400 10800 1 EEST} - {2076962400 7200 0 EET} - {2090440800 10800 1 EEST} - {2108412000 7200 0 EET} - {2121890400 10800 1 EEST} - {2139861600 7200 0 EET} - {2153340000 10800 1 EEST} - {2171916000 7200 0 EET} - {2184789600 10800 1 EEST} - {2203365600 7200 0 EET} - {2216239200 10800 1 EEST} - {2234815200 7200 0 EET} - {2248293600 10800 1 EEST} - {2266264800 7200 0 EET} - {2279743200 10800 1 EEST} - {2297714400 7200 0 EET} - {2311192800 10800 1 EEST} - {2329164000 7200 0 EET} - {2342642400 10800 1 EEST} - {2361218400 7200 0 EET} - {2374092000 10800 1 EEST} - {2392668000 7200 0 EET} - {2405541600 10800 1 EEST} - {2424117600 7200 0 EET} - {2437596000 10800 1 EEST} - {2455567200 7200 0 EET} - {2469045600 10800 1 EEST} - {2487016800 7200 0 EET} - {2500495200 10800 1 EEST} - {2519071200 7200 0 EET} - {2531944800 10800 1 EEST} - {2550520800 7200 0 EET} - {2563394400 10800 1 EEST} - {2581970400 7200 0 EET} - {2595448800 10800 1 EEST} - {2613420000 7200 0 EET} - {2626898400 10800 1 EEST} - {2644869600 7200 0 EET} - {2658348000 10800 1 EEST} - {2676319200 7200 0 EET} - {2689797600 10800 1 EEST} - {2708373600 7200 0 EET} - {2721247200 10800 1 EEST} - {2739823200 7200 0 EET} - {2752696800 10800 1 EEST} - {2771272800 7200 0 EET} - {2784751200 10800 1 EEST} - {2802722400 7200 0 EET} - {2816200800 10800 1 EEST} - {2834172000 7200 0 EET} - {2847650400 10800 1 EEST} - {2866226400 7200 0 EET} - {2879100000 10800 1 EEST} - {2897676000 7200 0 EET} - {2910549600 10800 1 EEST} - {2929125600 7200 0 EET} - {2941999200 10800 1 EEST} - {2960575200 7200 0 EET} - {2974053600 10800 1 EEST} - {2992024800 7200 0 EET} - {3005503200 10800 1 EEST} - {3023474400 7200 0 EET} - {3036952800 10800 1 EEST} - {3055528800 7200 0 EET} - {3068402400 10800 1 EEST} - {3086978400 7200 0 EET} - {3099852000 10800 1 EEST} - {3118428000 7200 0 EET} - {3131906400 10800 1 EEST} - {3149877600 7200 0 EET} - {3163356000 10800 1 EEST} - {3181327200 7200 0 EET} - {3194805600 10800 1 EEST} - {3212776800 7200 0 EET} - {3226255200 10800 1 EEST} - {3244831200 7200 0 EET} - {3257704800 10800 1 EEST} - {3276280800 7200 0 EET} - {3289154400 10800 1 EEST} - {3307730400 7200 0 EET} - {3321208800 10800 1 EEST} - {3339180000 7200 0 EET} - {3352658400 10800 1 EEST} - {3370629600 7200 0 EET} - {3384108000 10800 1 EEST} - {3402684000 7200 0 EET} - {3415557600 10800 1 EEST} - {3434133600 7200 0 EET} - {3447007200 10800 1 EEST} - {3465583200 7200 0 EET} - {3479061600 10800 1 EEST} - {3497032800 7200 0 EET} - {3510511200 10800 1 EEST} - {3528482400 7200 0 EET} - {3541960800 10800 1 EEST} - {3559932000 7200 0 EET} - {3573410400 10800 1 EEST} - {3591986400 7200 0 EET} - {3604860000 10800 1 EEST} - {3623436000 7200 0 EET} - {3636309600 10800 1 EEST} - {3654885600 7200 0 EET} - {3668364000 10800 1 EEST} - {3686335200 7200 0 EET} - {3699813600 10800 1 EEST} - {3717784800 7200 0 EET} - {3731263200 10800 1 EEST} - {3749839200 7200 0 EET} - {3762712800 10800 1 EEST} - {3781288800 7200 0 EET} - {3794162400 10800 1 EEST} - {3812738400 7200 0 EET} - {3825612000 10800 1 EEST} - {3844188000 7200 0 EET} - {3857666400 10800 1 EEST} - {3875637600 7200 0 EET} - {3889116000 10800 1 EEST} - {3907087200 7200 0 EET} - {3920565600 10800 1 EEST} - {3939141600 7200 0 EET} - {3952015200 10800 1 EEST} - {3970591200 7200 0 EET} - {3983464800 10800 1 EEST} - {4002040800 7200 0 EET} - {4015519200 10800 1 EEST} - {4033490400 7200 0 EET} - {4046968800 10800 1 EEST} - {4064940000 7200 0 EET} - {4078418400 10800 1 EEST} - {4096389600 7200 0 EET} + {1666998000 7200 0 EET} + {1679702400 10800 1 EEST} + {1698447600 7200 0 EET} + {1711756800 10800 1 EEST} + {1729897200 7200 0 EET} + {1743206400 10800 1 EEST} + {1761346800 7200 0 EET} + {1774656000 10800 1 EEST} + {1792796400 7200 0 EET} + {1806105600 10800 1 EEST} + {1824850800 7200 0 EET} + {1837555200 10800 1 EEST} + {1856300400 7200 0 EET} + {1869004800 10800 1 EEST} + {1887750000 7200 0 EET} + {1901059200 10800 1 EEST} + {1919199600 7200 0 EET} + {1932508800 10800 1 EEST} + {1950649200 7200 0 EET} + {1963958400 10800 1 EEST} + {1982703600 7200 0 EET} + {1995408000 10800 1 EEST} + {2014153200 7200 0 EET} + {2026857600 10800 1 EEST} + {2045602800 7200 0 EET} + {2058307200 10800 1 EEST} + {2077052400 7200 0 EET} + {2090361600 10800 1 EEST} + {2108502000 7200 0 EET} + {2121811200 10800 1 EEST} + {2139951600 7200 0 EET} + {2153260800 10800 1 EEST} + {2172006000 7200 0 EET} + {2184710400 10800 1 EEST} + {2203455600 7200 0 EET} + {2216160000 10800 1 EEST} + {2234905200 7200 0 EET} + {2248214400 10800 1 EEST} + {2266354800 7200 0 EET} + {2279664000 10800 1 EEST} + {2297804400 7200 0 EET} + {2311113600 10800 1 EEST} + {2329254000 7200 0 EET} + {2342563200 10800 1 EEST} + {2361308400 7200 0 EET} + {2374012800 10800 1 EEST} + {2392758000 7200 0 EET} + {2405462400 10800 1 EEST} + {2424207600 7200 0 EET} + {2437516800 10800 1 EEST} + {2455657200 7200 0 EET} + {2468966400 10800 1 EEST} + {2487106800 7200 0 EET} + {2500416000 10800 1 EEST} + {2519161200 7200 0 EET} + {2531865600 10800 1 EEST} + {2550610800 7200 0 EET} + {2563315200 10800 1 EEST} + {2582060400 7200 0 EET} + {2595369600 10800 1 EEST} + {2613510000 7200 0 EET} + {2626819200 10800 1 EEST} + {2644959600 7200 0 EET} + {2658268800 10800 1 EEST} + {2676409200 7200 0 EET} + {2689718400 10800 1 EEST} + {2708463600 7200 0 EET} + {2721168000 10800 1 EEST} + {2739913200 7200 0 EET} + {2752617600 10800 1 EEST} + {2771362800 7200 0 EET} + {2784672000 10800 1 EEST} + {2802812400 7200 0 EET} + {2816121600 10800 1 EEST} + {2834262000 7200 0 EET} + {2847571200 10800 1 EEST} + {2866316400 7200 0 EET} + {2879020800 10800 1 EEST} + {2897766000 7200 0 EET} + {2910470400 10800 1 EEST} + {2929215600 7200 0 EET} + {2941920000 10800 1 EEST} + {2960665200 7200 0 EET} + {2973974400 10800 1 EEST} + {2992114800 7200 0 EET} + {3005424000 10800 1 EEST} + {3023564400 7200 0 EET} + {3036873600 10800 1 EEST} + {3055618800 7200 0 EET} + {3068323200 10800 1 EEST} + {3087068400 7200 0 EET} + {3099772800 10800 1 EEST} + {3118518000 7200 0 EET} + {3131827200 10800 1 EEST} + {3149967600 7200 0 EET} + {3163276800 10800 1 EEST} + {3181417200 7200 0 EET} + {3194726400 10800 1 EEST} + {3212866800 7200 0 EET} + {3226176000 10800 1 EEST} + {3244921200 7200 0 EET} + {3257625600 10800 1 EEST} + {3276370800 7200 0 EET} + {3289075200 10800 1 EEST} + {3307820400 7200 0 EET} + {3321129600 10800 1 EEST} + {3339270000 7200 0 EET} + {3352579200 10800 1 EEST} + {3370719600 7200 0 EET} + {3384028800 10800 1 EEST} + {3402774000 7200 0 EET} + {3415478400 10800 1 EEST} + {3434223600 7200 0 EET} + {3446928000 10800 1 EEST} + {3465673200 7200 0 EET} + {3478982400 10800 1 EEST} + {3497122800 7200 0 EET} + {3510432000 10800 1 EEST} + {3528572400 7200 0 EET} + {3541881600 10800 1 EEST} + {3560022000 7200 0 EET} + {3573331200 10800 1 EEST} + {3592076400 7200 0 EET} + {3604780800 10800 1 EEST} + {3623526000 7200 0 EET} + {3636230400 10800 1 EEST} + {3654975600 7200 0 EET} + {3668284800 10800 1 EEST} + {3686425200 7200 0 EET} + {3699734400 10800 1 EEST} + {3717874800 7200 0 EET} + {3731184000 10800 1 EEST} + {3749929200 7200 0 EET} + {3762633600 10800 1 EEST} + {3781378800 7200 0 EET} + {3794083200 10800 1 EEST} + {3812828400 7200 0 EET} + {3825532800 10800 1 EEST} + {3844278000 7200 0 EET} + {3857587200 10800 1 EEST} + {3875727600 7200 0 EET} + {3889036800 10800 1 EEST} + {3907177200 7200 0 EET} + {3920486400 10800 1 EEST} + {3939231600 7200 0 EET} + {3951936000 10800 1 EEST} + {3970681200 7200 0 EET} + {3983385600 10800 1 EEST} + {4002130800 7200 0 EET} + {4015440000 10800 1 EEST} + {4033580400 7200 0 EET} + {4046889600 10800 1 EEST} + {4065030000 7200 0 EET} + {4078339200 10800 1 EEST} + {4096479600 7200 0 EET} } diff --git a/library/tzdata/Europe/Uzhgorod b/library/tzdata/Europe/Uzhgorod index 0a058db..2a0f450 100644 --- a/library/tzdata/Europe/Uzhgorod +++ b/library/tzdata/Europe/Uzhgorod @@ -1,254 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Europe/Uzhgorod) { - {-9223372036854775808 5352 0 LMT} - {-2500939752 3600 0 CET} - {-946774800 3600 0 CET} - {-938905200 7200 1 CEST} - {-857257200 3600 0 CET} - {-844556400 7200 1 CEST} - {-828226800 3600 0 CET} - {-812502000 7200 1 CEST} - {-796870800 7200 1 CEST} - {-794714400 3600 0 CET} - {-773456400 10800 0 MSD} - {354920400 14400 1 MSD} - {370728000 10800 0 MSK} - {386456400 14400 1 MSD} - {402264000 10800 0 MSK} - {417992400 14400 1 MSD} - {433800000 10800 0 MSK} - {449614800 14400 1 MSD} - {465346800 10800 0 MSK} - {481071600 14400 1 MSD} - {496796400 10800 0 MSK} - {512521200 14400 1 MSD} - {528246000 10800 0 MSK} - {543970800 14400 1 MSD} - {559695600 10800 0 MSK} - {575420400 14400 1 MSD} - {591145200 10800 0 MSK} - {606870000 14400 1 MSD} - {622594800 10800 0 MSK} - {631141200 10800 0 MSK} - {646786800 3600 0 CET} - {670384800 7200 0 EET} - {701042400 7200 0 EET} - {701827200 10800 1 EEST} - {717552000 7200 0 EET} - {733276800 10800 1 EEST} - {749001600 7200 0 EET} - {764726400 10800 1 EEST} - {780451200 7200 0 EET} - {796176000 10800 1 EEST} - {811900800 7200 0 EET} - {828230400 10800 1 EEST} - {831938400 10800 0 EEST} - {846378000 7200 0 EET} - {859683600 10800 1 EEST} - {877827600 7200 0 EET} - {891133200 10800 1 EEST} - {909277200 7200 0 EET} - {922582800 10800 1 EEST} - {941331600 7200 0 EET} - {954032400 10800 1 EEST} - {972781200 7200 0 EET} - {985482000 10800 1 EEST} - {1004230800 7200 0 EET} - {1017536400 10800 1 EEST} - {1035680400 7200 0 EET} - {1048986000 10800 1 EEST} - {1067130000 7200 0 EET} - {1080435600 10800 1 EEST} - {1099184400 7200 0 EET} - {1111885200 10800 1 EEST} - {1130634000 7200 0 EET} - {1143334800 10800 1 EEST} - {1162083600 7200 0 EET} - {1174784400 10800 1 EEST} - {1193533200 7200 0 EET} - {1206838800 10800 1 EEST} - {1224982800 7200 0 EET} - {1238288400 10800 1 EEST} - {1256432400 7200 0 EET} - {1269738000 10800 1 EEST} - {1288486800 7200 0 EET} - {1301187600 10800 1 EEST} - {1319936400 7200 0 EET} - {1332637200 10800 1 EEST} - {1351386000 7200 0 EET} - {1364691600 10800 1 EEST} - {1382835600 7200 0 EET} - {1396141200 10800 1 EEST} - {1414285200 7200 0 EET} - {1427590800 10800 1 EEST} - {1445734800 7200 0 EET} - {1459040400 10800 1 EEST} - {1477789200 7200 0 EET} - {1490490000 10800 1 EEST} - {1509238800 7200 0 EET} - {1521939600 10800 1 EEST} - {1540688400 7200 0 EET} - {1553994000 10800 1 EEST} - {1572138000 7200 0 EET} - {1585443600 10800 1 EEST} - {1603587600 7200 0 EET} - {1616893200 10800 1 EEST} - {1635642000 7200 0 EET} - {1648342800 10800 1 EEST} - {1667091600 7200 0 EET} - {1679792400 10800 1 EEST} - {1698541200 7200 0 EET} - {1711846800 10800 1 EEST} - {1729990800 7200 0 EET} - {1743296400 10800 1 EEST} - {1761440400 7200 0 EET} - {1774746000 10800 1 EEST} - {1792890000 7200 0 EET} - {1806195600 10800 1 EEST} - {1824944400 7200 0 EET} - {1837645200 10800 1 EEST} - {1856394000 7200 0 EET} - {1869094800 10800 1 EEST} - {1887843600 7200 0 EET} - {1901149200 10800 1 EEST} - {1919293200 7200 0 EET} - {1932598800 10800 1 EEST} - {1950742800 7200 0 EET} - {1964048400 10800 1 EEST} - {1982797200 7200 0 EET} - {1995498000 10800 1 EEST} - {2014246800 7200 0 EET} - {2026947600 10800 1 EEST} - {2045696400 7200 0 EET} - {2058397200 10800 1 EEST} - {2077146000 7200 0 EET} - {2090451600 10800 1 EEST} - {2108595600 7200 0 EET} - {2121901200 10800 1 EEST} - {2140045200 7200 0 EET} - {2153350800 10800 1 EEST} - {2172099600 7200 0 EET} - {2184800400 10800 1 EEST} - {2203549200 7200 0 EET} - {2216250000 10800 1 EEST} - {2234998800 7200 0 EET} - {2248304400 10800 1 EEST} - {2266448400 7200 0 EET} - {2279754000 10800 1 EEST} - {2297898000 7200 0 EET} - {2311203600 10800 1 EEST} - {2329347600 7200 0 EET} - {2342653200 10800 1 EEST} - {2361402000 7200 0 EET} - {2374102800 10800 1 EEST} - {2392851600 7200 0 EET} - {2405552400 10800 1 EEST} - {2424301200 7200 0 EET} - {2437606800 10800 1 EEST} - {2455750800 7200 0 EET} - {2469056400 10800 1 EEST} - {2487200400 7200 0 EET} - {2500506000 10800 1 EEST} - {2519254800 7200 0 EET} - {2531955600 10800 1 EEST} - {2550704400 7200 0 EET} - {2563405200 10800 1 EEST} - {2582154000 7200 0 EET} - {2595459600 10800 1 EEST} - {2613603600 7200 0 EET} - {2626909200 10800 1 EEST} - {2645053200 7200 0 EET} - {2658358800 10800 1 EEST} - {2676502800 7200 0 EET} - {2689808400 10800 1 EEST} - {2708557200 7200 0 EET} - {2721258000 10800 1 EEST} - {2740006800 7200 0 EET} - {2752707600 10800 1 EEST} - {2771456400 7200 0 EET} - {2784762000 10800 1 EEST} - {2802906000 7200 0 EET} - {2816211600 10800 1 EEST} - {2834355600 7200 0 EET} - {2847661200 10800 1 EEST} - {2866410000 7200 0 EET} - {2879110800 10800 1 EEST} - {2897859600 7200 0 EET} - {2910560400 10800 1 EEST} - {2929309200 7200 0 EET} - {2942010000 10800 1 EEST} - {2960758800 7200 0 EET} - {2974064400 10800 1 EEST} - {2992208400 7200 0 EET} - {3005514000 10800 1 EEST} - {3023658000 7200 0 EET} - {3036963600 10800 1 EEST} - {3055712400 7200 0 EET} - {3068413200 10800 1 EEST} - {3087162000 7200 0 EET} - {3099862800 10800 1 EEST} - {3118611600 7200 0 EET} - {3131917200 10800 1 EEST} - {3150061200 7200 0 EET} - {3163366800 10800 1 EEST} - {3181510800 7200 0 EET} - {3194816400 10800 1 EEST} - {3212960400 7200 0 EET} - {3226266000 10800 1 EEST} - {3245014800 7200 0 EET} - {3257715600 10800 1 EEST} - {3276464400 7200 0 EET} - {3289165200 10800 1 EEST} - {3307914000 7200 0 EET} - {3321219600 10800 1 EEST} - {3339363600 7200 0 EET} - {3352669200 10800 1 EEST} - {3370813200 7200 0 EET} - {3384118800 10800 1 EEST} - {3402867600 7200 0 EET} - {3415568400 10800 1 EEST} - {3434317200 7200 0 EET} - {3447018000 10800 1 EEST} - {3465766800 7200 0 EET} - {3479072400 10800 1 EEST} - {3497216400 7200 0 EET} - {3510522000 10800 1 EEST} - {3528666000 7200 0 EET} - {3541971600 10800 1 EEST} - {3560115600 7200 0 EET} - {3573421200 10800 1 EEST} - {3592170000 7200 0 EET} - {3604870800 10800 1 EEST} - {3623619600 7200 0 EET} - {3636320400 10800 1 EEST} - {3655069200 7200 0 EET} - {3668374800 10800 1 EEST} - {3686518800 7200 0 EET} - {3699824400 10800 1 EEST} - {3717968400 7200 0 EET} - {3731274000 10800 1 EEST} - {3750022800 7200 0 EET} - {3762723600 10800 1 EEST} - {3781472400 7200 0 EET} - {3794173200 10800 1 EEST} - {3812922000 7200 0 EET} - {3825622800 10800 1 EEST} - {3844371600 7200 0 EET} - {3857677200 10800 1 EEST} - {3875821200 7200 0 EET} - {3889126800 10800 1 EEST} - {3907270800 7200 0 EET} - {3920576400 10800 1 EEST} - {3939325200 7200 0 EET} - {3952026000 10800 1 EEST} - {3970774800 7200 0 EET} - {3983475600 10800 1 EEST} - {4002224400 7200 0 EET} - {4015530000 10800 1 EEST} - {4033674000 7200 0 EET} - {4046979600 10800 1 EEST} - {4065123600 7200 0 EET} - {4078429200 10800 1 EEST} - {4096573200 7200 0 EET} +if {![info exists TZData(Europe/Kyiv)]} { + LoadTimeZoneFile Europe/Kyiv } +set TZData(:Europe/Uzhgorod) $TZData(:Europe/Kyiv) diff --git a/library/tzdata/Europe/Zaporozhye b/library/tzdata/Europe/Zaporozhye index 8ae9604..385d862 100644 --- a/library/tzdata/Europe/Zaporozhye +++ b/library/tzdata/Europe/Zaporozhye @@ -1,253 +1,5 @@ # created by tools/tclZIC.tcl - do not edit - -set TZData(:Europe/Zaporozhye) { - {-9223372036854775808 8440 0 LMT} - {-2840149240 8400 0 +0220} - {-1441160400 7200 0 EET} - {-1247536800 10800 0 MSK} - {-894769200 3600 0 CET} - {-857257200 3600 0 CET} - {-844556400 7200 1 CEST} - {-828226800 3600 0 CET} - {-826419600 10800 0 MSD} - {354920400 14400 1 MSD} - {370728000 10800 0 MSK} - {386456400 14400 1 MSD} - {402264000 10800 0 MSK} - {417992400 14400 1 MSD} - {433800000 10800 0 MSK} - {449614800 14400 1 MSD} - {465346800 10800 0 MSK} - {481071600 14400 1 MSD} - {496796400 10800 0 MSK} - {512521200 14400 1 MSD} - {528246000 10800 0 MSK} - {543970800 14400 1 MSD} - {559695600 10800 0 MSK} - {575420400 14400 1 MSD} - {591145200 10800 0 MSK} - {606870000 14400 1 MSD} - {622594800 10800 0 MSK} - {638319600 14400 1 MSD} - {654649200 10800 0 MSK} - {670374000 10800 0 EEST} - {686091600 7200 0 EET} - {701042400 7200 0 EET} - {701827200 10800 1 EEST} - {717552000 7200 0 EET} - {733276800 10800 1 EEST} - {749001600 7200 0 EET} - {764726400 10800 1 EEST} - {780451200 7200 0 EET} - {796176000 10800 1 EEST} - {811900800 7200 0 EET} - {828230400 10800 1 EEST} - {831938400 10800 0 EEST} - {846378000 7200 0 EET} - {859683600 10800 1 EEST} - {877827600 7200 0 EET} - {891133200 10800 1 EEST} - {909277200 7200 0 EET} - {922582800 10800 1 EEST} - {941331600 7200 0 EET} - {954032400 10800 1 EEST} - {972781200 7200 0 EET} - {985482000 10800 1 EEST} - {1004230800 7200 0 EET} - {1017536400 10800 1 EEST} - {1035680400 7200 0 EET} - {1048986000 10800 1 EEST} - {1067130000 7200 0 EET} - {1080435600 10800 1 EEST} - {1099184400 7200 0 EET} - {1111885200 10800 1 EEST} - {1130634000 7200 0 EET} - {1143334800 10800 1 EEST} - {1162083600 7200 0 EET} - {1174784400 10800 1 EEST} - {1193533200 7200 0 EET} - {1206838800 10800 1 EEST} - {1224982800 7200 0 EET} - {1238288400 10800 1 EEST} - {1256432400 7200 0 EET} - {1269738000 10800 1 EEST} - {1288486800 7200 0 EET} - {1301187600 10800 1 EEST} - {1319936400 7200 0 EET} - {1332637200 10800 1 EEST} - {1351386000 7200 0 EET} - {1364691600 10800 1 EEST} - {1382835600 7200 0 EET} - {1396141200 10800 1 EEST} - {1414285200 7200 0 EET} - {1427590800 10800 1 EEST} - {1445734800 7200 0 EET} - {1459040400 10800 1 EEST} - {1477789200 7200 0 EET} - {1490490000 10800 1 EEST} - {1509238800 7200 0 EET} - {1521939600 10800 1 EEST} - {1540688400 7200 0 EET} - {1553994000 10800 1 EEST} - {1572138000 7200 0 EET} - {1585443600 10800 1 EEST} - {1603587600 7200 0 EET} - {1616893200 10800 1 EEST} - {1635642000 7200 0 EET} - {1648342800 10800 1 EEST} - {1667091600 7200 0 EET} - {1679792400 10800 1 EEST} - {1698541200 7200 0 EET} - {1711846800 10800 1 EEST} - {1729990800 7200 0 EET} - {1743296400 10800 1 EEST} - {1761440400 7200 0 EET} - {1774746000 10800 1 EEST} - {1792890000 7200 0 EET} - {1806195600 10800 1 EEST} - {1824944400 7200 0 EET} - {1837645200 10800 1 EEST} - {1856394000 7200 0 EET} - {1869094800 10800 1 EEST} - {1887843600 7200 0 EET} - {1901149200 10800 1 EEST} - {1919293200 7200 0 EET} - {1932598800 10800 1 EEST} - {1950742800 7200 0 EET} - {1964048400 10800 1 EEST} - {1982797200 7200 0 EET} - {1995498000 10800 1 EEST} - {2014246800 7200 0 EET} - {2026947600 10800 1 EEST} - {2045696400 7200 0 EET} - {2058397200 10800 1 EEST} - {2077146000 7200 0 EET} - {2090451600 10800 1 EEST} - {2108595600 7200 0 EET} - {2121901200 10800 1 EEST} - {2140045200 7200 0 EET} - {2153350800 10800 1 EEST} - {2172099600 7200 0 EET} - {2184800400 10800 1 EEST} - {2203549200 7200 0 EET} - {2216250000 10800 1 EEST} - {2234998800 7200 0 EET} - {2248304400 10800 1 EEST} - {2266448400 7200 0 EET} - {2279754000 10800 1 EEST} - {2297898000 7200 0 EET} - {2311203600 10800 1 EEST} - {2329347600 7200 0 EET} - {2342653200 10800 1 EEST} - {2361402000 7200 0 EET} - {2374102800 10800 1 EEST} - {2392851600 7200 0 EET} - {2405552400 10800 1 EEST} - {2424301200 7200 0 EET} - {2437606800 10800 1 EEST} - {2455750800 7200 0 EET} - {2469056400 10800 1 EEST} - {2487200400 7200 0 EET} - {2500506000 10800 1 EEST} - {2519254800 7200 0 EET} - {2531955600 10800 1 EEST} - {2550704400 7200 0 EET} - {2563405200 10800 1 EEST} - {2582154000 7200 0 EET} - {2595459600 10800 1 EEST} - {2613603600 7200 0 EET} - {2626909200 10800 1 EEST} - {2645053200 7200 0 EET} - {2658358800 10800 1 EEST} - {2676502800 7200 0 EET} - {2689808400 10800 1 EEST} - {2708557200 7200 0 EET} - {2721258000 10800 1 EEST} - {2740006800 7200 0 EET} - {2752707600 10800 1 EEST} - {2771456400 7200 0 EET} - {2784762000 10800 1 EEST} - {2802906000 7200 0 EET} - {2816211600 10800 1 EEST} - {2834355600 7200 0 EET} - {2847661200 10800 1 EEST} - {2866410000 7200 0 EET} - {2879110800 10800 1 EEST} - {2897859600 7200 0 EET} - {2910560400 10800 1 EEST} - {2929309200 7200 0 EET} - {2942010000 10800 1 EEST} - {2960758800 7200 0 EET} - {2974064400 10800 1 EEST} - {2992208400 7200 0 EET} - {3005514000 10800 1 EEST} - {3023658000 7200 0 EET} - {3036963600 10800 1 EEST} - {3055712400 7200 0 EET} - {3068413200 10800 1 EEST} - {3087162000 7200 0 EET} - {3099862800 10800 1 EEST} - {3118611600 7200 0 EET} - {3131917200 10800 1 EEST} - {3150061200 7200 0 EET} - {3163366800 10800 1 EEST} - {3181510800 7200 0 EET} - {3194816400 10800 1 EEST} - {3212960400 7200 0 EET} - {3226266000 10800 1 EEST} - {3245014800 7200 0 EET} - {3257715600 10800 1 EEST} - {3276464400 7200 0 EET} - {3289165200 10800 1 EEST} - {3307914000 7200 0 EET} - {3321219600 10800 1 EEST} - {3339363600 7200 0 EET} - {3352669200 10800 1 EEST} - {3370813200 7200 0 EET} - {3384118800 10800 1 EEST} - {3402867600 7200 0 EET} - {3415568400 10800 1 EEST} - {3434317200 7200 0 EET} - {3447018000 10800 1 EEST} - {3465766800 7200 0 EET} - {3479072400 10800 1 EEST} - {3497216400 7200 0 EET} - {3510522000 10800 1 EEST} - {3528666000 7200 0 EET} - {3541971600 10800 1 EEST} - {3560115600 7200 0 EET} - {3573421200 10800 1 EEST} - {3592170000 7200 0 EET} - {3604870800 10800 1 EEST} - {3623619600 7200 0 EET} - {3636320400 10800 1 EEST} - {3655069200 7200 0 EET} - {3668374800 10800 1 EEST} - {3686518800 7200 0 EET} - {3699824400 10800 1 EEST} - {3717968400 7200 0 EET} - {3731274000 10800 1 EEST} - {3750022800 7200 0 EET} - {3762723600 10800 1 EEST} - {3781472400 7200 0 EET} - {3794173200 10800 1 EEST} - {3812922000 7200 0 EET} - {3825622800 10800 1 EEST} - {3844371600 7200 0 EET} - {3857677200 10800 1 EEST} - {3875821200 7200 0 EET} - {3889126800 10800 1 EEST} - {3907270800 7200 0 EET} - {3920576400 10800 1 EEST} - {3939325200 7200 0 EET} - {3952026000 10800 1 EEST} - {3970774800 7200 0 EET} - {3983475600 10800 1 EEST} - {4002224400 7200 0 EET} - {4015530000 10800 1 EEST} - {4033674000 7200 0 EET} - {4046979600 10800 1 EEST} - {4065123600 7200 0 EET} - {4078429200 10800 1 EEST} - {4096573200 7200 0 EET} +if {![info exists TZData(Europe/Kyiv)]} { + LoadTimeZoneFile Europe/Kyiv } +set TZData(:Europe/Zaporozhye) $TZData(:Europe/Kyiv) diff --git a/tests/cmdAH.test b/tests/cmdAH.test index b52d105..0af66bf 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -1177,10 +1177,10 @@ test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0 catch {file link -symbolic $linkfile $gorpfile} test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body { file lstat a -} -result {wrong # args: should be "file lstat name varName"} +} -result {could not read "a": no such file or directory} test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body { file lstat a b c -} -result {wrong # args: should be "file lstat name varName"} +} -result {wrong # args: should be "file lstat name ?varName?"} test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup { unset -nocomplain stat } -constraints {unix nonPortable} -body { @@ -1510,14 +1510,14 @@ catch {file attributes $gorpfile -permissions 0o765} # stat test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body { - file stat _bogus_ -} -result {wrong # args: should be "file stat name varName"} + file stat +} -result {wrong # args: should be "file stat name ?varName?"} test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body { file stat _bogus_ a b -} -result {wrong # args: should be "file stat name varName"} +} -result {wrong # args: should be "file stat name ?varName?"} test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup { unset -nocomplain stat - set stat(blocks) [set stat(blksize) {}] + array set stat {blocks {} blksize {}} } -body { file stat $gorpfile stat unset stat(blocks) stat(blksize); # Ignore these fields; not always set @@ -1610,6 +1610,16 @@ test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints } set res } -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0} +test cmdAH-28.14 {Tcl_FileObjCmd: stat} -setup { + unset -nocomplain stat +} -body { + file stat $gorpfile stat + expr { + [lsort -stride 2 [array get stat]] + eq + [lsort -stride 2 [file stat $gorpfile]] + } +} -result {1} unset -nocomplain stat # type diff --git a/tests/event.test b/tests/event.test index 3f9735a..16cbc24 100644 --- a/tests/event.test +++ b/tests/event.test @@ -509,12 +509,9 @@ test event-10.1 {Tcl_Exit procedure} {stdio} { [lindex $::errorCode 2] } {1 {child process exited abnormally} CHILDSTATUS 3} -test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body { +test event-11.1 {Tcl_VwaitCmd procedure} -body { vwait -} -result {wrong # args: should be "vwait name"} -test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body { - vwait a b -} -result {wrong # args: should be "vwait name"} +} -result {} test event-11.3 {Tcl_VwaitCmd procedure} -setup { catch {unset x} } -body { diff --git a/tests/io.test b/tests/io.test index 1db6632..44be164 100644 --- a/tests/io.test +++ b/tests/io.test @@ -9057,6 +9057,124 @@ test io-75.10 {incomplete shiftjis encoding read is ignored} -setup { # ### ### ### ######### ######### ######### + + +test io-75.0 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {read {}} + +test io-75.1 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {{} write} + +test io-75.2 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {read write} + +test io-75.3 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mremove-wr $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{read {}} {read {}}} + +test io-75.4 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mremove-rd $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.5 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mremove-rd $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{{} write} {{} write}} + +test io-75.6 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mremove-wr $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.7 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-rd $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{{} write} {read write}} + +test io-75.8 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-wr $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{read {}} {read write}} + +test io-75.9 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-wr $f + testchannel mremove-rd $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.10 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-rd $f + testchannel mremove-wr $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + # cleanup foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { diff --git a/tests/lseq.test b/tests/lseq.test new file mode 100644 index 0000000..ffb8a94 --- /dev/null +++ b/tests/lseq.test @@ -0,0 +1,482 @@ +# Commands covered: lseq +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright © 2003 Simon Geard. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +if {"::tcltest" ni [namespace children]} { + package require tcltest 2.5 + namespace import -force ::tcltest::* +} + +testConstraint arithSeriesDouble 1 +testConstraint arithSeriesShimmer 1 +testConstraint arithSeriesShimmerOk 0 + +## Arg errors +test lseq-1.1 {error cases} -body { + lseq +} \ + -returnCodes 1 \ + -result {wrong # args: should be "lseq n ??op? n ??by? n??"} + + +test lseq-1.2 {step magnitude} { + lseq 10 .. 1 by -2 ;# or this could be an error - or not +} {10 8 6 4 2} + +test lseq-1.3 {synergy between int and double} { + set rl [lseq 25. to 5. by -5] + set il [lseq 25 to 5 by -5] + lmap r $rl i $il { if {$r ne "" && $i ne ""} {expr {int($r) == $i}} else {list $r $i} } +} {1 1 1 1 1} + +test lseq-1.4 {integer decreasing} { + lseq 10 .. 1 +} {10 9 8 7 6 5 4 3 2 1} + +test lseq-1.5 {integer increasing} { + lseq 1 .. 10 +} {1 2 3 4 5 6 7 8 9 10} + +test lseq-1.6 {integer decreasing with step} { + lseq 10 .. 1 by -2 +} {10 8 6 4 2} + +test lseq-1.7 {real increasing lseq} arithSeriesDouble { + lseq 5.0 to 15. +} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} + +test lseq-1.8 {real increasing lseq with step} arithSeriesDouble { + lseq 5.0 to 25. by 5 +} {5.0 10.0 15.0 20.0 25.0} + +test lseq-1.9 {real decreasing with step} arithSeriesDouble { + lseq 25. to 5. by -5 +} {25.0 20.0 15.0 10.0 5.0} + +# note, 10 cannot be in such a list, but allowed +test lseq-1.10 {integer lseq with step} { + lseq 1 to 10 by 2 +} {1 3 5 7 9} + +test lseq-1.11 {error case: increasing wrong step direction} { + lseq 1 to 10 by -2 +} {} + +test lseq-1.12 {decreasing lseq with step} arithSeriesDouble { + lseq 25. to -25. by -5 +} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} + +test lseq-1.13 {count operation} { + -body { + lseq 5 count 5 + } + -result {5 6 7 8 9} +} + +test lseq-1.14 {count with step} { + -body { + lseq 5 count 5 by 2 + } + -result {5 7 9 11 13} +} + +test lseq-1.15 {count with decreasing step} { + -body { + lseq 5 count 5 by -2 + } + -result {5 3 1 -1 -3} +} + +test lseq-1.16 {large numbers} { + -body { + lseq [expr {int(1e6)}] [expr {int(2e6)}] [expr {int(1e5)}] + } + -result {1000000 1100000 1200000 1300000 1400000 1500000 1600000 1700000 1800000 1900000 2000000} +} + +test lseq-1.17 {too many arguments} -body { + lseq 12 to 24 by 2 with feeling +} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"} + +test lseq-1.18 {too many arguments extra valid keyword} -body { + lseq 12 to 24 by 2 count +} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"} + +test lseq-1.19 {too many arguments extra numeric value} -body { + lseq 12 to 24 by 2 7 +} -returnCodes 1 -result {wrong # args: should be "lseq n ??op? n ??by? n??"} + +test lseq-1.20 {bug: wrong length computed} { + lseq 1 to 10 -1 +} {} + +test lseq-1.21 {n n by n} { + lseq 66 84 by 3 +} {66 69 72 75 78 81 84} + +test lseq-1.22 {n n by -n} { + lseq 84 66 by -3 +} {84 81 78 75 72 69 66} + +# +# Short-hand use cases +# +test lseq-2.2 {step magnitude} { + lseq 10 1 2 ;# this is an empty case since step has wrong sign +} {} + +test lseq-2.3 {step wrong sign} arithSeriesDouble { + lseq 25. 5. 5 ;# ditto - empty list +} {} + +test lseq-2.4 {integer decreasing} { + lseq 10 1 +} {10 9 8 7 6 5 4 3 2 1} + +test lseq-2.5 {integer increasing} { + lseq 1 10 +} {1 2 3 4 5 6 7 8 9 10} + +test lseq-2.6 {integer decreasing with step} { + lseq 10 1 by -2 +} {10 8 6 4 2} + +test lseq-2.7 {real increasing lseq} arithSeriesDouble { + lseq 5.0 15. +} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} + + +test lseq-2.8 {real increasing lseq with step} arithSeriesDouble { + lseq 5.0 25. 5 +} {5.0 10.0 15.0 20.0 25.0} + + +test lseq-2.9 {real decreasing with step} arithSeriesDouble { + lseq 25. 5. -5 +} {25.0 20.0 15.0 10.0 5.0} + +test lseq-2.10 {integer lseq with step} { + lseq 1 10 2 +} {1 3 5 7 9} + +test lseq-2.11 {error case: increasing wrong step direction} { + lseq 1 10 -2 +} {} + +test lseq-2.12 {decreasing lseq with step} arithSeriesDouble { + lseq 25. -25. -5 +} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} + +test lseq-2.13 {count only operation} { + lseq 5 +} {0 1 2 3 4} + +test lseq-2.14 {count with step} { + lseq 5 count 5 2 +} {5 7 9 11 13} + +test lseq-2.15 {count with decreasing step} { + lseq 5 count 5 -2 +} {5 3 1 -1 -3} + +test lseq-2.16 {large numbers} { + lseq 1e6 2e6 1e5 +} {1000000.0 1100000.0 1200000.0 1300000.0 1400000.0 1500000.0 1600000.0 1700000.0 1800000.0 1900000.0 2000000.0} + +test lseq-2.17 {large numbers} arithSeriesDouble { + lseq 1e6 2e6 1e5 +} {1000000.0 1100000.0 1200000.0 1300000.0 1400000.0 1500000.0 1600000.0 1700000.0 1800000.0 1900000.0 2000000.0} + +# Covered: {10 1 2 } {1 10 2} {1 10 -2} {1 1 1} {1 1 1} {-5 17 3} +# Missing: {- - +} {- - -} {- + -} {+ - -} {- - +} {+ + -} +test lseq-2.18 {signs} { + list [lseq -10 -1 2] \ + [lseq -10 -1 -1] \ + [lseq -10 1 -3] \ + [lseq 10 -1 -4] \ + [lseq -10 -1 3] \ + [lseq 10 1 -5] + +} {{-10 -8 -6 -4 -2} {} {} {10 6 2} {-10 -7 -4 -1} {10 5}} + +test lseq-3.1 {experiement} { + set ans {} + foreach factor [lseq 2.0 10.0] { + set start 1 + set end 10 + for {set step 1} {$step < 1e8} {} { + set l [lseq $start to $end by $step] + if {[llength $l] != 10} { + lappend ans $factor $step [llength $l] $l + } + set step [expr {$step * $factor}] + set end [expr {$end * $factor}] + } + } + if {$ans eq {}} { + set ans OK + } + set ans +} {OK} + +test lseq-3.2 {error case} -body { + lseq foo +} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by} + +test lseq-3.3 {error case} -body { + lseq 10 foo +} -returnCodes 1 -result {bad operation "foo": must be .., to, count, or by} + +test lseq-3.4 {error case} -body { + lseq 25 or 6 +} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by} + +test lseq-3.5 {simple count and step arguments} { + set s [lseq 25 by 6] + list $s length=[llength $s] +} {{0 6 12 18 24 30 36 42 48 54 60 66 72 78 84 90 96 102 108 114 120 126 132 138 144} length=25} + +test lseq-3.6 {error case} -body { + lseq 1 7 or 3 +} -returnCodes 1 -result {bad operation "or": must be .., to, count, or by} + +test lseq-3.7 {lmap lseq} { + lmap x [lseq 5] { expr {$x * $x} } +} {0 1 4 9 16} + +test lseq-3.8 {lrange lseq} { + set r [lrange [lseq 1 100] 10 20] + lindex [tcl::unsupported::representation $r] 3 +} {arithseries} + +test lseq-3.9 {lassign lseq} arithSeriesShimmer { + set r [lseq 15] + set r2 [lassign $r a b] + list [lindex [tcl::unsupported::representation $r] 3] $a $b \ + [lindex [tcl::unsupported::representation $r2] 3] +} {arithseries 0 1 arithseries} + +test lseq-3.10 {lsearch lseq must shimmer?} arithSeriesShimmer { + set r [lseq 15 0] + set a [lsearch $r 9] + list [lindex [tcl::unsupported::representation $r] 3] $a +} {arithseries 6} + +test lseq-3.11 {lreverse lseq} { + set r [lseq 15 0] + set a [lreverse $r] + join [list \ + [lindex [tcl::unsupported::representation $r] 3] \ + $r \ + [lindex [tcl::unsupported::representation $a] 3] \ + $a] \n +} {arithseries +15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 +arithseries +0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} + +test lseq-3.12 {in operator} { + set r [lseq 9] + set i [expr {7 in $r}] + set j [expr {10 ni $r}] + set k [expr {-1 in $r}] + set l [expr {4 ni $r}] + list $i $j $k $l [lindex [tcl::unsupported::representation $r] 3] +} {1 1 0 0 arithseries} + +test lseq-3.13 {lmap lseq shimmer} arithSeriesShimmer { + set r [lseq 15] + set rep-before [lindex [tcl::unsupported::representation $r] 3] + set m [lmap i $r { expr {$i * 7} }] + set rep-after [lindex [tcl::unsupported::representation $r] 3] + set rep-m [lindex [tcl::unsupported::representation $m] 3] + list $r ${rep-before} ${rep-after} ${rep-m} $m +} {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries arithseries list {0 7 14 21 28 35 42 49 56 63 70 77 84 91 98}} + +test lseq-3.14 {array for shimmer} arithSeriesShimmerOk { + array set testarray {a Test for This great Function} + set vars [lseq 2] + set vars-rep [lindex [tcl::unsupported::representation $vars] 3] + array for $vars testarray { + lappend keys $0 + lappend vals $1 + } + # Since hash order is not guaranteed, have to validate content ignoring order + set valk [lmap k $keys {expr {$k in {a for great}}}] + set valv [lmap v $vals {expr {$v in {Test This Function}}}] + set vars-after [lindex [tcl::unsupported::representation $vars] 3] + list ${vars-rep} $valk $valv ${vars-after} +} {arithseries {1 1 1} {1 1 1} arithseries} + +test lseq-3.15 {join for shimmer} arithSeriesShimmer { + set r [lseq 3] + set rep-before [lindex [tcl::unsupported::representation $r] 3] + set str [join $r :] + set rep-after [lindex [tcl::unsupported::representation $r] 3] + list ${rep-before} $str ${rep-after} +} {arithseries 0:1:2 arithseries} + +test lseq-3.16 {error case} -body { + lseq 16 to +} -returnCodes 1 -result {missing "to" value.} + +test lseq-3.17 {error case} -body { + lseq 17 to 13 by +} -returnCodes 1 -result {missing "by" value.} + +test lseq-3.18 {error case} -body { + lseq 18 count +} -returnCodes 1 -result {missing "count" value.} + +test lseq-3.19 {edge case} -body { + lseq 1 count 5 by 0 +} -result {} +# 1 1 1 1 1 + +# My thought is that this is likely a user error, since they can always use lrepeat for this. + +test lseq-3.20 {edge case} -body { + lseq 1 to 1 by 0 +} -result {} + +# hmmm, I guess this is right, in a way, so... + +test lseq-3.21 {edge case} { + lseq 1 to 1 by 1 +} {1} + +test lseq-3.22 {edge case} { + lseq 1 1 1 +} {1} + +test lseq-3.23 {edge case} { + llength [lseq 1 1 1] +} {1} + +test lseq-3.24 {edge case} { + llength [lseq 1 to 1 1] +} {1} + +test lseq-3.25 {edge case} { + llength [lseq 1 to 1 by 1] +} {1} + +test lseq-3.26 {lsort shimmer} arithSeriesShimmer { + set r [lseq 15 0] + set rep-before [lindex [tcl::unsupported::representation $r] 3] + set lexical_sort [lsort $r] + set rep-after [lindex [tcl::unsupported::representation $r] 3] + list ${rep-before} $lexical_sort ${rep-after} +} {arithseries {0 1 10 11 12 13 14 15 2 3 4 5 6 7 8 9} arithseries} + +test lseq-3.27 {lreplace shimmer} arithSeriesShimmer { + set r [lseq 15 0] + set rep-before [lindex [tcl::unsupported::representation $r] 3] + set lexical_sort [lreplace $r 3 5 A B C] + set rep-after [lindex [tcl::unsupported::representation $r] 3] + list ${rep-before} $lexical_sort ${rep-after} +} {arithseries {15 14 13 A B C 9 8 7 6 5 4 3 2 1 0} arithseries} + +test lseq-3.28 {lreverse bug in ArithSeries} {} { + set r [lseq -5 17 3] + set rr [lreverse $r] + list $r $rr [string equal $r [lreverse $rr]] +} {{-5 -2 1 4 7 10 13 16} {16 13 10 7 4 1 -2 -5} 1} + +test lseq-3.29 {edge case: negative count} { + lseq -15 +} {} + +test lseq-3.30 {lreverse with double values} arithSeriesDouble { + set r [lseq 3.5 18.5 1.5] + set a [lreverse $r] + join [list \ + [lindex [tcl::unsupported::representation $r] 3] \ + $r \ + [lindex [tcl::unsupported::representation $a] 3] \ + $a] \n +} {arithseries +3.5 5.0 6.5 8.0 9.5 11.0 12.5 14.0 15.5 17.0 18.5 +arithseries +18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5} + +test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble { + lreverse [lseq 1.1 29.9 0.3] +} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014} + +test lseq-4.1 {end expressions} { + set start 7 + lseq $start $start+11 +} {7 8 9 10 11 12 13 14 15 16 17 18} + +test lseq-4.2 {start expressions} { + set base [clock seconds] + set tl [lseq $base-60 $base 10] + lmap t $tl {expr {$t - $base + 60}} +} {0 10 20 30 40 50 60} + +## lseq 1 to 10 by -2 +## # -> lseq: invalid step = -2 with a = 1 and b = 10 + +test lseq-4.3 {TIP examples} { + set examples {# Examples from TIP-629 + # --- Begin --- + lseq 10 .. 1 + # -> 10 9 8 7 6 5 4 3 2 1 + lseq 1 .. 10 + # -> 1 2 3 4 5 6 7 8 9 10 + lseq 10 .. 1 by 2 + # -> + lseq 10 .. 1 by -2 + # -> 10 8 6 4 2 + lseq 5.0 to 15. + # -> 5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0 + lseq 5.0 to 25. by 5 + # -> 5.0 10.0 15.0 20.0 25.0 + lseq 25. to 5. by 5 + # -> + lseq 25. to 5. by -5 + # -> 25.0 20.0 15.0 10.0 5.0 + lseq 1 to 10 by 2 + # -> 1 3 5 7 9 + lseq 25. to -25. by -5 + # -> 25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0 + lseq 5 5 + # -> 5 + lseq 5 5 2 + # -> 5 + lseq 5 5 -2 + # -> 5 + } + + foreach {cmd expect} [split $examples \n] { + if {[string trim $cmd] ne ""} { + set cmd [string trimleft $cmd] + if {[string match {\#*} $cmd]} continue + set status [catch $cmd ans] + lappend res $ans + if {[regexp {\# -> (.*)$} $expect -> expected]} { + if {$expected ne $ans} { + lappend res [list Mismatch: $cmd -> $ans ne $expected] + } + } + } + } + set res +} {{10 9 8 7 6 5 4 3 2 1} {1 2 3 4 5 6 7 8 9 10} {} {10 8 6 4 2} {5.0 6.0 7.0 8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0} {5.0 10.0 15.0 20.0 25.0} {} {25.0 20.0 15.0 10.0 5.0} {1 3 5 7 9} {25.0 20.0 15.0 10.0 5.0 0.0 -5.0 -10.0 -15.0 -20.0 -25.0} 5 5 5} + + +# cleanup +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# End: diff --git a/tests/stringObj.test b/tests/stringObj.test index e63cbdc..263e7ef 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -495,27 +495,32 @@ test stringObj-16.5 {Tcl_GetRange: first = last = TCL_INDEX_NONE} testobj { teststringobj set 1 abcde teststringobj range 1 -1 -1 } abcde -test stringObj-16.6 {Tcl_GetRange: first = UINT_MAX-1} testobj { +test stringObj-16.6 {Tcl_GetRange: old anomaly} testobj { + # Older implementations could return "cde" + teststringobj set 1 abcde + teststringobj range 1 2 0 +} {} +test stringObj-16.7 {Tcl_GetRange: first = UINT_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 0xFFFFFFFE 3 } {} -test stringObj-16.7 {Tcl_GetRange: first = SIZE_MAX-1} testobj { +test stringObj-16.8 {Tcl_GetRange: first = SIZE_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 -2 3 } {} -test stringObj-16.8 {Tcl_GetRange: last = UINT_MAX-1} testobj { +test stringObj-16.9 {Tcl_GetRange: last = UINT_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 1 0xFFFFFFFE } bcde -test stringObj-16.9 {Tcl_GetRange: last = SIZE_MAX-1} testobj { +test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 1 -2 } bcde -test stringObj-16.10 {Tcl_GetRange: first = last = UINT_MAX-1} testobj { +test stringObj-16.11 {Tcl_GetRange: first = last = UINT_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 0xFFFFFFFE 0xFFFFFFFE } {} -test stringObj-16.11 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj { +test stringObj-16.12 {Tcl_GetRange: first = last = SIZE_MAX-1} testobj { teststringobj set 1 abcde teststringobj range 1 -2 -2 } {} diff --git a/tests/switch.test b/tests/switch.test index 2fce108..3d106c0 100644 --- a/tests/switch.test +++ b/tests/switch.test @@ -745,6 +745,13 @@ test switch-14.16 {switch -regexp compilation} { } }} } no +test switch-14.17 {switch -regexp bug [c0bc269178]} { + set result {} + switch -regexp -matchvar m -indexvar i ac { + {(a)(b)?(c)} {set result $m} + } + set result +} {ac a {} c} test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{ -body { diff --git a/unix/Makefile.in b/unix/Makefile.in index 2f44045..c6e4469 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -299,8 +299,8 @@ XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \ - tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \ - tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ + tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \ + tclCkalloc.o tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \ tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \ tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \ tclEncoding.o tclEnsemble.o \ @@ -395,7 +395,8 @@ GENERIC_HDRS = \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ - $(GENERIC_DIR)/tclRegexp.h + $(GENERIC_DIR)/tclRegexp.h \ + $(GENERIC_DIR)/tclArithSeries.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ @@ -403,6 +404,7 @@ GENERIC_SRCS = \ $(GENERIC_DIR)/regfree.c \ $(GENERIC_DIR)/regerror.c \ $(GENERIC_DIR)/tclAlloc.c \ + $(GENERIC_DIR)/tclArithSeries.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ @@ -1254,6 +1256,9 @@ tclAppInit.o: $(UNIX_DIR)/tclAppInit.c tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c +tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR) + $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c + tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c diff --git a/win/Makefile.in b/win/Makefile.in index 1018464..090bc46 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -280,6 +280,7 @@ GENERIC_OBJS = \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ + tclArithSeries.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ diff --git a/win/makefile.vc b/win/makefile.vc index 65edc66..06d577c 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -236,6 +236,7 @@ COREOBJS = \ $(TMP_DIR)\regexec.obj \
$(TMP_DIR)\regfree.obj \
$(TMP_DIR)\tclAlloc.obj \
+ $(TMP_DIR)\tclArithSeries.obj \
$(TMP_DIR)\tclAssembly.obj \
$(TMP_DIR)\tclAsync.obj \
$(TMP_DIR)\tclBasic.obj \
|