Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch tip-636-tcl9 Excluding Merge-Ins
This is equivalent to a diff from 4014e2a164 to db4e5a6372
2022-11-06
| ||
20:27 | Update Tcl_Filesystem documentation check-in: 6b3203fd37 user: jan.nijtmans tags: trunk, main | |
11:19 | Rebase TIP #626 to latest 9.0. Change Tcl version number from 9.0 to 9.1a0 check-in: efcf7c37fe user: jan.nijtmans tags: tip-626 | |
05:20 | Sync with trunk check-in: 6a10d9194c user: griffin tags: tip-636-tcl9-644 | |
2022-11-05
| ||
23:35 | Sync with trunk Closed-Leaf check-in: db4e5a6372 user: griffin tags: tip-636-tcl9 | |
11:49 | Merge 8.7. lreplace4 bcc instruction and FLT_MAX fix check-in: 4014e2a164 user: apnadkarni tags: trunk, main | |
10:28 | Add lreplace4 BCC instruction. Rewrite linsert, lreplace to use it. check-in: 7541ec8fb1 user: apnadkarni tags: core-8-branch | |
2022-11-03
| ||
12:26 | Bug [0f98bce669]. Fix limits for string replace. check-in: 997d8c2052 user: apnadkarni tags: trunk, main | |
2022-11-02
| ||
22:33 | TIP 636 for Tcl 9 check-in: b78cb72678 user: griffin tags: tip-636-tcl9 | |
Added doc/AbstractListObj.3.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 | '\" '\" Copyright (c) 2022 Brian Griffin. 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 Tcl_AbstractListType 3 8.7 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_AbstractListObjNew, Tcl_AbsstractListObjCopy, Tcl_AbstractListGetConcreteRep, Tcl_AbstractListGetElements, Tcl_AbstractListGetType, Tcl_AbstractListObjIndex, Tcl_AbstractListObjLength, Tcl_AbstractListObjRange, Tcl_AbstractListObjReverse, Tcl_AbstractListSetConcreteRep, \- manipulate Tcl values as abstract lists. .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Obj * \fBTcl_AbstractListObjNew\fR(\fIinterp, abstractListType\fR) Tcl_AbstractListType * \fBTcl_AbstractListGetType\fR(\fIlistPtr\fR) void \fBTcl_AbstractListSetConcreteRep\fR(\fIlistPtr, repPtr\fR) void * \fBTcl_AbstractListGetConcreteRep\fR(\fIlistPtr\fR) Tcl_WideInt \fBTcl_AbstractListObjLength\fR(\fIlistPtr\fR) int \fBTcl_AbstractListObjIndex\fR(\fIinterp\fR, \fIlistPtr, index\fR, \fIelemObjPtr*\fR) int \fBTcl_AbstractListObjRange\fR(\fIinterp\fR, \fIlistPtr, fromIdx, toIdx\fR, \fInewObjPtr\fR) int \fBTcl_AbstractListObjReverse(\fIinterp\fR, \fIlistPtr\fR, \fInewObjPtr\fR) int \fBTcl_AbstraceListObjGetElements\fR(\fIinterp\fR, \fIlistPtr\fR, \fIobjcPtr\fR, \fIobjvPtr\fR) Tcl_Obj * \fBTcl_AbstractListObjCopy\fR(\fIinterp\fR, \fIlistPtr\fR); typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]); typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); typedef Tcl_WideInt (Tcl_ALLengthProc) (Tcl_Obj *listPtr); typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_WideInt index, Tcl_Obj** elemObj); typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_WideInt fromIdx, Tcl_WideInt toIdx, Tcl_Obj **newObjPtr); typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj **newObjPtr); typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcptr, Tcl_Obj ***objvptr); typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr); typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr); .SH ARGUMENTS .AS .AP Tcl_Interp *interp in If an error occurs while converting a value to be a list value, an error message is left in the interpreter's result value unless \fIinterp\fR is NULL. .AP Tcl_AbstractListType *abstractListType in This structure defines the behavior for the \fBAbstractList\fR for a given concrete \fBAbstractList\fR type. The struct provides the name plus a collection of functions that implement the various List operations on the AbstractType value. \fBTcl_AbstractListObjNew\fR call creates a new Tcl_Obj based on a preinitilized AbstractList struct. .AP Tcl_Obj *listPtr in/out A Tcl_Obj of type AbstractList. Use to read or modify the type or value content an AbstractList type. .AP void *repPtr in A reference to the concrete type representation storage. Specific concrete types allocate and use this space to store whatever details of value are needed. .AP Tcl_WideInt index in Index of the list element that \fBTcl_AbstractListObjIndex\fR is to return. The first element has index 0. .AP Tcl_Obj **elemObjPtr A location where the returned reference to an element Obj is to be stored. .AP Tcl_WideInt fromIdx in The starting index of the list element for the slice that \fBTcl_AbstractListObjRange\fR is to return. .AP Tcl_WideInt toIdx in The ending index of the list element for the slice that \fBTcl_AbstractListObjRange\fR is to return. .AP Tcl_Obj **newObjPtr in A location where the new slice or reversed Obj reference is to be stored. .AP (Tcl_ALNewObjProc) in Function pointer for a function used to create new instances of the custom AbstractList listPtr. .AP (Tcl_ALDupRepProc) in Function pointer for a function used to duplicate (make a copy) of the custom AbstractList listPtr. .AP (Tcl_ALLengthProc) in Function pointer for a function used to return the length of the custom AbstractList. .AP (Tcl_ALIndexProc) in Function pointer for a function used to return an element listPtr for the given index value. .AP (Tcl_ALSliceProc) in Function pointer for a function used to create a new slice from an existing AbstractList. .AP (Tcl_ALReverseProc) in Function pointer for a function used to create a new AbstractList with the element order reversed. .BE .SH DESCRIPTION .PP The AbstractList type provides an interface for creating new List type representations. An AbstractList behaves like a List when using script level list commands. How the values are stored or produced is up to the implementation. A simple example of an AbstractList is the [lseq] command which produces a list of numeric values in sequence. The underlying implementation does not store a list of numeric values. Instead, it produces values on demand based on the index using an arithmetic expression: "value = start + (step * index)". .PP An AbstractList is created by defining an internal storage representation for the list along with a set of functions that manage and manipulate the list value(s). These functions provide "List" like results from the List family of commands. .SH ABSTRACTLIST C API .PP \fBTcl_AbstractListObjNew\fR returns a new Tcl_Obj based on the concrete type definition given. The caller must then complete the initialization of the Obj by setting the concrete represtation. (see \fBTcl_AbstractListSetConcreteRep\fR()) \fBTcl_AbstractListGetType\fR returns the Tcl_AbstractList struct for the given Obj. This function is used internally to access the implementation functions. It can also be used in a specific implementation to confirm that the Obj is of the expected AbstractList type. \fBTcl_AbstractListSetConcreteRep\fR is called when creating an instance of an AbstractList. It stores the repPtr, to the allocated value Representation, in the Tcl_Obj. \fBTcl_AbstractListGetConcreteRep\fR returns the previously stored repPtr for a given Obj value. \fBTcl_AbstractListObjLength\fR returns the list length, i.e., number of elements in the given AbstractList. This function is typically used internally by when evaluating various List operations. It would not typically be used by an AbstractList concrete implementaion since the internal representation is readily available within the implementation, presumably. \fBTcl_AbstractListObjIndex\fR returns the element Tcl_Obj for a given index location. \fBTcl_AbstractListObjRange\fR returns a new Obj value constructed from a slice of the original AbstractList value, ranging from \fIfromIdx\fR to the \fItoIdx\fR. If this function is not provided, the default behavior will be to construct a traditional List using the Index function. \fBTcl_AbstractListObjReverse\fR returns a new Obj value constructed by reversing the index order. If this function is not provided, the default behavior will be to construct a traditional List using the Index function. \fBTcl_AbstraceListObjGetElements\fR returns an objv array containing all elements of the AbstractList. (*** need words about memory ownership ***) \fBTcl_AbstractListObjCopy\fR returns a duplicate Obj from the original. .SH ABSTRACTLIST IMPLEMENTATION FUNCTIONS The following functions are to be defined by a specific implementation to provide full or parcial List compatible behavior. The Length and Index functions are required, and the rest are optional. Unimplemented functions will either use a default implementation that relies on Length and Index functions, or, the AbstractList will "shimmer" into a formal List value. .PP .CS typedef Tcl_Obj* (Tcl_ALNewObjProc) (int objc, Tcl_Obj * const objv[]); typedef void (Tcl_ALDupRepProc) (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); typedef Tcl_WideInt (Tcl_ALLengthProc) (Tcl_Obj *listPtr); typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_WideInt index, Tcl_Obj** elemObj); typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_WideInt fromIdx, Tcl_WideInt toIdx, Tcl_Obj **newObjPtr); typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj **newObjPtr); typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcptr, Tcl_Obj ***objvptr); typedef void (Tcl_ALFreeConcreteRep) (Tcl_Obj *listPtr); typedef void (Tcl_ALToStringRep) (Tcl_Obj *listPtr); .CE .PP .SH AbstractList Example .PP \fBTcl_AbstractListObjNew\fR is used to create an object with a custom List representation. .PP .CS /* ** Define the AbstractList type callbacks */ static \fBTcl_AbstractListType\fR arithSeriesType = { TCL_ABSTRACTLIST_VERSION_1, "arithseries", Tcl_NewArithSeriesObj, DupArithSeriesRep, TclArithSeriesObjLength, TclArithSeriesObjIndex, TclArithSeriesObjRange, TclArithSeriesObjReverse, TclArithSeriesGetElements, FreeArithSeriesRep, UpdateStringOfArithSeries }; .CE .PP The Index and Length procs must be defined. The others are optional. If an optional proc is not defined, it may use a default routine that makes use of Length and Index, or the value will be converted to a List, and then the operation will proceed normally, and note: this will permanently change the value representation to a \fBList\fR representation. .PP .CS /* ** Define the concrete representation for the ArithSeries type */ typedef struct ArithSeries { int start, int end, int step, int length } ArithSeries; /* ** Allocate and initialize the concrete repdresentation. */ arithSeriesRepPtr = (ArithSeries*)\fBTcl_Alloc\fR(sizeof (ArithSeries)); arithSeriesRepPtr->isDouble = 0; arithSeriesRepPtr->start = 0; arithSeriesRepPtr->end = 15; arithSeriesRepPtr->step = 1; arithSeriesRepPtr->len = 15; arithSeriesRepPtr->elements = NULL; /* ** Create an instance Tcl_Obj */ \fBTcl_Obj\fR *arithObj = \fBTcl_AbstractListObjNew\fR(interp, &arithSeriesType); /* ** Set the concrete value for the Obj. */ \fBTcl_AbstractListSetConcreteRep\fR(arithObj, arithSeriesRepPtr); return arithObj; .CE .PP If any List operation is used to modify the AbstractList, for example [lset $abstraceList 3 17], it will first be converted to a List before completing the change. .PP .CS /* Example functions */ Tcl_Obj* ArithSeriesObjIndex(Tcl_Obj *arithSeriesObjPtr, Tcl_WideInt index) { ArithSeries *arithSeriesRepPtr; Tcl_WideInt element; if (arithSeriesObjPtr->typePtr != &tclAbstractListType) { Tcl_Panic("ArithSeriesObjIndex called with a not ArithSeries Obj."); } arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr); if (index < 0 || index >= arithSeriesRepPtr->length) { return NULL; } /* List[i] = Start + (Step * i) */ element = (arithSeriesRepPtr->start + (index) * arithSeriesRepPtr->step); return Tcl_NewWideIntObj(element); } Tcl_WideInt ArithSeriesObjLength(Tcl_Obj *arithSeriesObjPtr) { ArithSeries *arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObjPtr); return arithSeriesRepPtr->length; } .CE .PP The functions \fBTcl_AbstractListObjLength\fR, \fBTcl_AbstractListObjIndex\fR, \fBTcl_AbstractListObjRange\fR, and \fBTcl_AbstractListObjReverse\fR can be used to interact with a known AbstatractList Tcl_Obj value, as well as \fBTcl_ListObjLength\fR, \fBTcl_ListObjIndex\fR, without causing the obj value to converted to a \fBList\fR. Tcl_ListObjGetElements can also be used on an AbstractList, just note that this call may result in new element objects being created for every element in the abstract list. Since an abstract list can be arbitrarily large and not consume space, this call may have undesired consequences. .PP .SH "SEE ALSO" Tcl_NewListObj(3), Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_GetObjResult(3) .SH KEYWORDS index, internal representation, length, list, list value, list type, value, value type, replace, string representation |
Changes to doc/lseq.n.
︙ | ︙ | |||
17 18 19 20 21 22 23 | \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 | | | > | > > > > > > > > > > > > > > > > > > > > > | > | < < | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 | \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 the range. The "count" option is used to define a count of the number of elements in the list. A short form use of the command, with a single count value, will create a range from 0 to count-1. The \fBlseq\fR command can produce both increasing and decreasing sequences. When both Start and End are provided without a Step value, then if Start <= End, the sequence will be increasing and if Start > End it will be decreasing. If a Step vale is included, it's sign should agree with the direction of the sequence (descending -> negative and ascending -> positive), otherwise an empty list is returned. For example: .CS \" % lseq 1 to 5 ;# increasing 1 2 3 4 5 % lseq 5 to 1 ;# decreasing 5 4 3 2 1 % lseq 6 to 1 by 2 ;# decreasing, step wrong sign, empty list % lseq 1 to 5 by 0 ;# all step sizes of 0 produce an empty list .\" .CE The numeric arguments, \fIStart\fR, \fIEnd\fR, \fIStep\fR, and \fICount\fR, may also be a valid expression. The expression will be evaluate and the numeric result be used. An expression that does not evaluate to a number will produce an invalid argument error. .SH EXAMPLES .CS .\" lseq 3 \(-> 0 1 2 |
︙ | ︙ | |||
63 64 65 66 67 68 69 | \(-> l(5)=-5 l(4)=-4 l(3)=-3 l(2)=-2 l(1)=-1 l(0)=0 | < < < < < < < < < | | | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | \(-> l(5)=-5 l(4)=-4 l(3)=-3 l(2)=-2 l(1)=-1 l(0)=0 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: |
Changes to generic/tcl.decls.
︙ | ︙ | |||
2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 | int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) } # TIP 643 declare 683 { int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 | int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) } # TIP 643 declare 683 { int Tcl_GetEncodingNulLength(Tcl_Encoding encoding) } # TIP #636 declare 684 { Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr) } declare 685 { Tcl_Obj *Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr) } declare 686 { Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr) } declare 687 { int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr) } declare 688 { int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr) } declare 689 { int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr) } declare 690 { int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) } declare 691 { Tcl_Obj *Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr) } declare 692 { void *Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr) } declare 693 { Tcl_Obj *Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj) } # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
689 690 691 692 693 694 695 696 697 698 699 700 701 702 | * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ Tcl_ObjInternalRep internalRep; /* The internal representation: */ } Tcl_Obj; /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see * tclInt.h). */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 | * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ Tcl_ObjInternalRep internalRep; /* The internal representation: */ } Tcl_Obj; /* * Abstract List * * This structure provides the functions used in List operations to emulate a * List for AbstractList types. */ /* Abstract List functions */ typedef struct Tcl_Obj* (Tcl_ALNewObjProc) (Tcl_Size objc, struct Tcl_Obj * const objv[]); typedef void (Tcl_ALDupRepProc) (struct Tcl_Obj *srcPtr, struct Tcl_Obj *copyPtr); typedef Tcl_WideInt (Tcl_ALLengthProc) (struct Tcl_Obj *listPtr); typedef int (Tcl_ALIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, Tcl_Size index, struct Tcl_Obj** elemObj); typedef int (Tcl_ALSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); typedef int (Tcl_ALReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr); typedef int (Tcl_ALGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); typedef void (Tcl_ALFreeConcreteRep) (struct Tcl_Obj *listPtr); typedef void (Tcl_ALToStringRep) (struct Tcl_Obj *listPtr); typedef struct Tcl_Obj* (Tcl_ALSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, Tcl_Size indexCount, struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj); typedef int (Tcl_ALReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]); typedef enum { TCL_ABSL_NEW, TCL_ABSL_DUPREP, TCL_ABSL_LENGTH, TCL_ABSL_INDEX, TCL_ABSL_SLICE, TCL_ABSL_REVERSE, TCL_ABSL_GETELEMENTS, TCL_ABSL_FREEREP, TCL_ABSL_TOSTRING, TCL_ABSL_SETELEMENT, TCL_ABSL_REPLACE } Tcl_AbstractListProcType; typedef struct Tcl_AbstractListVersion_ *Tcl_AbstractListVersion; #define TCL_ABSTRACTLIST_VERSION_1 ((Tcl_AbstractListVersion) 0x1) /* Virtual function dispatch a la Tcl_ObjType but for AbstractList */ typedef struct Tcl_AbstractListType { Tcl_AbstractListVersion version;/* Structure version */ const char *typeName; /* Custom value reference */ /* List emulation functions */ Tcl_ALNewObjProc *newObjProc; /* How to create a new Tcl_Obj of this ** custom type */ Tcl_ALDupRepProc *dupRepProc; /* How to duplicate a internal rep of this ** custom type */ Tcl_ALLengthProc *lengthProc; /* Return the [llength] of the ** AbstractList */ Tcl_ALIndexProc *indexProc; /* Return a value (Tcl_Obj) for ** [lindex $al $index] */ Tcl_ALSliceProc *sliceProc; /* Return an AbstractList for ** [lrange $al $start $end] */ Tcl_ALReverseProc *reverseProc; /* Return an AbstractList for ** [lreverse $al] */ Tcl_ALGetElements *getElementsProc; /* Return an objv[] of all elements in ** the list */ Tcl_ALFreeConcreteRep *freeRepProc; /* Free ConcreteRep internals if ** necessary */ Tcl_ALToStringRep *toStringProc; /* Optimized "to-string" conversion ** for updating the string rep */ Tcl_ALSetElement *setElementProc; /* Replace the element at the indicie ** with the given valueObj. */ Tcl_ALReplaceProc *replaceProc; /* Replace subset with subset */ } Tcl_AbstractListType; /* * Sets the storage used by the concrete abstract list type * Caller has to ensure type is AbstractList. Existing rep will be * overwritten so caller has to free previous rep if necessary. */ static inline void Tcl_AbstractListSetConcreteRep( Tcl_Obj *objPtr, /* Object of type AbstractList */ void *repPtr) /* New representation */ { /* assert(objPtr->typePtr == &tclAbstractListType); */ objPtr->internalRep.twoPtrValue.ptr1 = repPtr; } /* *---------------------------------------------------------------------------- * The following structure contains the state needed by Tcl_SaveResult. No-one * outside of Tcl should access any of these fields. This structure is * typically allocated on the stack. */ #ifndef TCL_NO_DEPRECATED typedef struct Tcl_SavedResult { char *result; Tcl_FreeProc *freeProc; Tcl_Obj *objResultPtr; char *appendResult; int appendAvl; int appendUsed; char resultSpace[200+1]; } Tcl_SavedResult; #endif /* *---------------------------------------------------------------------------- * The following definitions support Tcl's namespace facility. Note: the first * five fields must match exactly the fields in a Namespace structure (see * tclInt.h). */ |
︙ | ︙ |
Added generic/tclAbstractList.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 | /* * tclAbstractList.h -- * * The AbstractList Obj Type -- a psuedo List * * Copyright © 2022 by Brian Griffin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tcl.h" #include "tclAbstractList.h" /* -------------------------- AbstractList object ---------------------------- */ /* * Prototypes for procedures defined later in this file: */ static void DupAbstractListInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeAbstractListInternalRep (Tcl_Obj *listPtr); static int SetAbstractListFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfAbstractList (Tcl_Obj *listPtr); /* * The structure below defines the AbstractList Tcl object type by means of * procedures that can be invoked by generic object code. * * The abstract list object is a special case of Tcl list represented by a set * of functions. * */ const Tcl_ObjType tclAbstractListType = { "abstractlist", /* name */ FreeAbstractListInternalRep, /* freeIntRepProc */ DupAbstractListInternalRep, /* dupIntRepProc */ UpdateStringOfAbstractList, /* updateStringProc */ SetAbstractListFromAny /* setFromAnyProc */ }; /* *---------------------------------------------------------------------- * * Tcl_AbstractListLen -- * * Compute the length of the equivalent list * * Results: * * The length of the list generated by the given range, * that may be zero. * * Side effects: * * None. * *---------------------------------------------------------------------- */ Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListObjPtr) { return AbstractListObjLength(abstractListObjPtr); } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjNew() * * Creates a new AbstractList object. The returned object has * refcount = 0. * * Results: * * A Tcl_Obj pointer to the created AbstractList object. * A NULL pointer of the range is invalid. * * Side Effects: * * None. *---------------------------------------------------------------------- */ Tcl_Obj* Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType* vTablePtr) { Tcl_Obj *objPtr; Tcl_ObjInternalRep itr; (void)interp; TclNewObj(objPtr); Tcl_StoreInternalRep(objPtr, &tclAbstractListType, &itr); Tcl_AbstractListSetType(objPtr, (void*)vTablePtr); /* dispatch table for concrete type */ Tcl_AbstractListSetConcreteRep(objPtr, NULL); Tcl_InvalidateStringRep(objPtr); return objPtr; } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjIndex -- * * Returns the element with the specified index in the list * represented by the specified Abstract List 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: * * Element Tcl_Obj is returned on succes, NULL on index out of range. * *---------------------------------------------------------------------- */ int Tcl_AbstractListObjIndex( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *abstractListObjPtr, /* List obj */ Tcl_Size index, /* index to element of interest */ Tcl_Obj **elemObjPtr) /* Return value */ { Tcl_AbstractListType *typePtr; typePtr = Tcl_AbstractListGetType(abstractListObjPtr); /* * The general assumption is that the obj is assumed first to be a List, * and only ends up here because it has been determinded to be an * AbstractList. If that's not the case, then a mistake has been made. To * attempt to try a List call (e.g. shimmer) could potentially loop(?) * So: if called from List code, then something has gone wrong; if called * from user code, then user has made a mistake. */ if (typePtr == NULL) { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("Tcl_AbstractListObjIndex called without and AbstractList Obj.", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); return TCL_ERROR; } } return typePtr->indexProc(interp, abstractListObjPtr, index, elemObjPtr); } /* *---------------------------------------------------------------------- * * FreeAbstractListInternalRep -- * * Deallocate the storage associated with an abstract list object's * internal representation. * * Results: * None. * * Side effects: * Frees abstractListPtr's AbstractList* internal representation and * sets listPtr's internalRep.twoPtrValue.ptr2 to NULL. * *---------------------------------------------------------------------- */ void FreeAbstractListInternalRep(Tcl_Obj *abstractListObjPtr) { Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr); if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_FREEREP)) { /* call the free callback for the concrete rep */ typePtr->freeRepProc(abstractListObjPtr); } abstractListObjPtr->internalRep.twoPtrValue.ptr2 = NULL; abstractListObjPtr->internalRep.twoPtrValue.ptr1 = NULL; } /* *---------------------------------------------------------------------- * * DupAbstractListInternalRep -- * * Initialize the internal representation of a AbstractList Tcl_Obj to a * copy of the internal representation of an existing abstractlist object. * * Results: * None. * * Side effects: * We set "copyPtr"s internal rep to a pointer to a * newly allocated AbstractList structure. *---------------------------------------------------------------------- */ static void DupAbstractListInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. * Internal rep must be clear, it is stomped */ { Tcl_AbstractListType *typePtr; typePtr = Tcl_AbstractListGetType(srcPtr); Tcl_AbstractListSetType(copyPtr, typePtr); Tcl_AbstractListSetConcreteRep(copyPtr, NULL); /* Now do concrete type dup. It is responsible for calling Tcl_AbstractListSetConcreteRep to initialize ptr2 */ if (typePtr->dupRepProc) { typePtr->dupRepProc(srcPtr, copyPtr); } else { /* TODO - or set it to NULL instead? */ Tcl_AbstractListSetConcreteRep (copyPtr, Tcl_AbstractListGetConcreteRep(srcPtr)); } copyPtr->typePtr = &tclAbstractListType; } /* *---------------------------------------------------------------------- * * UpdateStringOfAbstractList -- * * Update the string representation for an abstractlist 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 * listlike-to-string conversion. This string will be empty if the * AbstractList is empty. * * Notes: * This simple approach is costly in that it forces a string rep for each * element, which is then tossed. Improving the performance here may * require implementing a custom size-calculation function for each * subtype of AbstractList. * *---------------------------------------------------------------------- */ static void UpdateStringOfAbstractList(Tcl_Obj *abstractListObjPtr) { # define LOCAL_SIZE 64 char localFlags[LOCAL_SIZE], *flagPtr = NULL; Tcl_AbstractListType *typePtr; char *p; int bytesNeeded = 0; int llen, i; /* * TODO - this function essentially adapts the UpdateStringOfList function * for native lists. Both functions allocate temporary storage for * localFlags. I'm not sure if that is the best strategy for performance * as well as memory for large list sizes. Revisit to see if growing * the allocation on the fly would be better. Essentially combine the * TclScanElement and TclConvertElement into one loop, growing the * destination allocation if necessary. */ typePtr = Tcl_AbstractListGetType(abstractListObjPtr); /* * If concrete type has a better way to generate the string, * let it do it. */ if (TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_TOSTRING)) { typePtr->toStringProc(abstractListObjPtr); return; } /* * TODO - do we need a AbstractList method to mark the list as canonical? * Or perhaps are abstract lists always canonical? * Mark the list as being canonical; although it will now have a string * rep, it is one we derived through proper "canonical" quoting and so * it's known to be free from nasties relating to [concat] and [eval]. * listRepPtr->canonicalFlag = 1; */ /* * Handle empty list case first, so rest of the routine is simpler. */ llen = typePtr->lengthProc(abstractListObjPtr); if (llen <= 0) { Tcl_InitStringRep(abstractListObjPtr, NULL, 0); return; } /* * Pass 1: estimate space. */ if (llen <= LOCAL_SIZE) { flagPtr = localFlags; } else { /* We know numElems <= LIST_MAX, so this is safe. */ flagPtr = (char *) Tcl_Alloc(llen); } for (bytesNeeded = 0, i = 0; i < llen; i++) { Tcl_Obj *elemObj; const char *elemStr; int elemLen; flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0); typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj); Tcl_IncrRefCount(elemObj); elemStr = TclGetStringFromObj(elemObj, &elemLen); /* Note TclScanElement updates flagPtr[i] */ bytesNeeded += TclScanElement(elemStr, elemLen, flagPtr+i); if (bytesNeeded < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } Tcl_DecrRefCount(elemObj); } if (bytesNeeded > INT_MAX - llen + 1) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } bytesNeeded += llen; /* Separating spaces and terminating nul */ /* * Pass 2: generate the string repr. */ abstractListObjPtr->bytes = (char *) Tcl_Alloc(bytesNeeded); p = abstractListObjPtr->bytes; for (i = 0; i < llen; i++) { Tcl_Obj *elemObj; const char *elemStr; int elemLen; flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0); typePtr->indexProc(NULL, abstractListObjPtr, i, &elemObj); Tcl_IncrRefCount(elemObj); elemStr = TclGetStringFromObj(elemObj, &elemLen); p += TclConvertElement(elemStr, elemLen, p, flagPtr[i]); *p++ = ' '; Tcl_DecrRefCount(elemObj); } p[-1] = '\0'; /* Overwrite last space added */ /* Length of generated string */ abstractListObjPtr->length = p - 1 - abstractListObjPtr->bytes; if (flagPtr != localFlags) { Tcl_Free(flagPtr); } } /* *---------------------------------------------------------------------- * * SetAbstractListFromAny -- * * The AbstractList object is just a way to optimize * Lists space complexity, so no one should try to convert * a string to an AbstractList 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 SetAbstractListFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { (void)interp; (void)objPtr; /* TODO - at some future point, should just shimmer to a traditional * Tcl list (but only when those are implemented under the AbstractList) * interface. */ Tcl_Panic("SetAbstractListFromAny: should never be called"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjCopy -- * * Makes a "pure AbstractList" copy of an AbstractList 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 * abstractList value as *abstractListPtr does. The returned Tcl_Obj has a * refCount of zero. If *abstractListPtr does not hold an AbstractList, * NULL is returned, and if interp is non-NULL, an error message is * recorded there. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_AbstractListObjCopy( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *abstractListObjPtr) /* List object for which an element array is * to be returned. */ { Tcl_Obj *copyPtr; if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) { if (SetAbstractListFromAny(interp, abstractListObjPtr) != TCL_OK) { /* We know this is going to panic, but it's the message we want */ return NULL; } } TclNewObj(copyPtr); TclInvalidateStringRep(copyPtr); DupAbstractListInternalRep(abstractListObjPtr, copyPtr); return copyPtr; } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjRange -- * * Makes a slice of an AbstractList value. * *abstractListObjPtr must be known to be a valid AbstractList. * * Results: * Returns a pointer to the sliced array. * This may be a new object or the same object if not shared. * * Side effects: * * ?The possible conversion of the object referenced by * abstractListObjPtr to a list object.? * *---------------------------------------------------------------------- */ int Tcl_AbstractListObjRange( Tcl_Interp *interp, /* For error messages. */ Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */ Tcl_Size fromIdx, /* Index of first element to include. */ Tcl_Size toIdx, /* Index of last element to include. */ Tcl_Obj **newObjPtr) /* return value */ { Tcl_AbstractListType *typePtr; if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("Not an AbstractList.", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); } return TCL_ERROR; } typePtr = Tcl_AbstractListGetType(abstractListObjPtr); /* * sliceProc can be NULL, then revert to List. Note: [lrange] * command also checks for NULL sliceProc, and won't call AbstractList */ if (typePtr->sliceProc) { return typePtr->sliceProc(interp, abstractListObjPtr, fromIdx, toIdx, newObjPtr); } else { /* TODO ?shimmer avoided? */ Tcl_Obj *newObj = TclListObjCopy(NULL, abstractListObjPtr); *newObjPtr = (newObj ? TclListObjRange(newObj, (Tcl_Size)fromIdx, (Tcl_Size)toIdx) : NULL); return (newObj ? TCL_OK : TCL_ERROR); } } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjReverse -- * * Reverses the order of an AbstractList value. * *abstractListObjPtr must be known to be a valid AbstractList. * * Results: * Returns a pointer to the reversed array. * This may be a new object or the same object if not shared. * * Side effects: * * ?The possible conversion of the object referenced by * abstractListObjPtr to a list object.? * *---------------------------------------------------------------------- */ int Tcl_AbstractListObjReverse( Tcl_Interp *interp, /* for reporting errors. */ Tcl_Obj *abstractListObjPtr, /* List object to take a range from. */ Tcl_Obj **newObjPtr) /* New AbstractListObj */ { Tcl_AbstractListType *typePtr; if (!TclHasInternalRep(abstractListObjPtr, &tclAbstractListType)) { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("Not an AbstractList.", -1)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); } return TCL_ERROR; } if (!TclAbstractListHasProc(abstractListObjPtr, TCL_ABSL_REVERSE)) { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("lreverse not supported!", -1)); Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREVERSE", NULL); } return TCL_ERROR; } typePtr = Tcl_AbstractListGetType(abstractListObjPtr); return typePtr->reverseProc(interp, abstractListObjPtr, newObjPtr); } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjGetElements -- * * 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 Tcl_AbstractListObjGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *objPtr, /* AbstractList object for which an element * array is to be returned. */ Tcl_Size *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,&tclAbstractListType)) { Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr); if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS)) { int status = typePtr->getElementsProc(interp, objPtr, objcPtr, objvPtr); return status; } else { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("GetElements not supported!", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } } return TCL_ERROR; } else { if (interp != NULL) { Tcl_SetObjResult( interp, Tcl_ObjPrintf("value is not an abstract list")); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); } return TCL_ERROR; } return TCL_OK; } /* * Returns pointer to the concrete type or NULL if not AbstractList or * not abstract list of the same type as concrete type */ Tcl_AbstractListType * Tcl_AbstractListGetType( Tcl_Obj *objPtr) /* Object of type AbstractList */ { if (objPtr->typePtr != &tclAbstractListType) { return NULL; } return (Tcl_AbstractListType *) objPtr->internalRep.twoPtrValue.ptr2; } /* Returns the storage used by the concrete abstract list type */ void* Tcl_AbstractListGetConcreteRep( Tcl_Obj *objPtr) /* Object of type AbstractList */ { /* Public function, must check for NULL */ if (objPtr == NULL || objPtr->typePtr != &tclAbstractListType) { return NULL; } return objPtr->internalRep.twoPtrValue.ptr1; } /* Replace or add the element in the list @indicies with the given new value */ Tcl_Obj * Tcl_AbstractListSetElement( Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj) { Tcl_Obj *returnObj = NULL; if (TclHasInternalRep(objPtr,&tclAbstractListType)) { Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr); if (TclAbstractListHasProc(objPtr, TCL_ABSL_SETELEMENT)) { returnObj = typePtr->setElementProc(interp, objPtr, indexCount, indexArray, valueObj); } else { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("SetElement not supported!", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } returnObj = NULL; } } else { if (interp != NULL) { Tcl_SetObjResult( interp, Tcl_ObjPrintf("value is not an abstract list")); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); } returnObj = NULL; } return returnObj; } /* *---------------------------------------------------------------------- * * Tcl_AbstractListObjReplace -- * * This function mimics the Tcl_ListObjReplace operation, iff the * concrete abstract list type supports the Replace operation, and if * not, it will return with an error. * * This function replaces zero or more elements of the abstract list * referenced by listObj with the objects from an (objc,objv) array. The * objc elements of the array referenced by objv replace the count * elements in listPtr starting at first. * * If the argument first is zero or negative, it refers to the first * element. If first is greater than or equal to the number of elements * in the list, then no elements are deleted; the new elements are * appended to the list. Count gives the number of elements to replace. * If count is zero or negative then no elements are deleted; the new * elements are simply inserted before first. * * The argument objv refers to an array of objc pointers to the new * elements to be added to listPtr in place of those that were deleted. * If objv is NULL, no new elements are added. * * Results: * The return value is normally TCL_OK. If listPtr does not support the * Replace opration then TCL_ERROR is returned and an error message will * be left in the interpreter's result if interp is not NULL. * * Side effects: * The ref counts of the objc elements in objv maybe incremented iff the * concrete type retains a reference to the element(s), otherwise there * will be no change to the ref counts. Similarly, the ref counts for * replaced objects are decremented. listObj's old string representation, * if any, is freed. * *---------------------------------------------------------------------- */ int Tcl_AbstractListObjReplace( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* List object whose elements to replace. */ Tcl_Size first, /* Index of first element to replace. */ Tcl_Size numToDelete, /* Number of elements to replace. */ Tcl_Size numToInsert, /* Number of objects to insert. */ Tcl_Obj *const insertObjs[]) /* Tcl objects to insert */ { int status; if (TclHasInternalRep(objPtr,&tclAbstractListType)) { Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(objPtr); if (TclAbstractListHasProc(objPtr, TCL_ABSL_REPLACE)) { status = typePtr->replaceProc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } else { if (interp) { Tcl_SetObjResult( interp, Tcl_NewStringObj("Replace not supported!", -1)); Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL); } status = TCL_ERROR; } } else { if (interp != NULL) { Tcl_SetObjResult( interp, Tcl_ObjPrintf("value is not an abstract list")); Tcl_SetErrorCode(interp, "TCL", "VALUE", "UNKNOWN", NULL); } status = TCL_ERROR; } return status; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Added generic/tclAbstractList.h.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | /* * tclAbstractList.h -- * * The AbstractList Obj Type -- a psuedo List * * Copyright © 2022 by Brian Griffin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #ifndef _TCLABSTRACTLIST #define _TCLABSTRACTLIST #include "tclInt.h" static inline const char* Tcl_AbstractListTypeName( Tcl_Obj *objPtr) /* Should be of type AbstractList */ { Tcl_AbstractListType *typePtr; typePtr = Tcl_AbstractListGetType(objPtr); if (typePtr && typePtr->typeName) { return typePtr->typeName; } else { return "abstractlist"; } } Tcl_Obj * Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType *vTablePtr); Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr); int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObj); int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr); int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr); Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj); int Tcl_AbstractListObjReplace(Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert, Tcl_Obj *const insertObjs[]); #endif /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclArithSeries.c.
1 2 3 4 5 6 7 8 9 10 11 12 | /* * 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. */ | | | | | < | < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | > > > > > > | | > | | | > | | | > > > > > > > > > > > > > > > > > | > > > > > | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | /* * 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 <assert.h> #include "tcl.h" #include "tclInt.h" #include "tclArithSeries.h" /* * The structure below defines the arithmetic series Tcl Obj Type by means of * procedures that can be invoked by generic object code. * * The arithmetic series object is a Tcl_AbstractList 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 list's 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. */ static inline double ArithSeriesIndexDbl(ArithSeriesDbl *repPtr, double index) { return (repPtr->start + (index * repPtr->step)); } static inline Tcl_WideInt ArithSeriesIndexInt(ArithSeries *repPtr, Tcl_Size index) { return (repPtr->start + (index * repPtr->step)); } static int TclArithSeriesObjStep(Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj); static int TclArithSeriesObjIndex(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Size index, Tcl_Obj **elemObj); static Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj); static int TclArithSeriesObjRange(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); static int TclArithSeriesObjReverse(Tcl_Interp *interp, Tcl_Obj *arithSeriesPtr, Tcl_Obj **newObjPtr); static int TclArithSeriesGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); static Tcl_Obj *TclNewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len); static Tcl_Obj *TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len); static void DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr); static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr); static Tcl_Obj *Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[]); static Tcl_AbstractListType arithSeriesType = { TCL_ABSTRACTLIST_VERSION_1, "arithseries", Tcl_NewArithSeriesObj, DupArithSeriesRep, TclArithSeriesObjLength, TclArithSeriesObjIndex, TclArithSeriesObjRange, TclArithSeriesObjReverse, TclArithSeriesGetElements, FreeArithSeriesRep, UpdateStringOfArithSeries, NULL, // SetElement NULL // Replace }; /* *---------------------------------------------------------------------- * * 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 infiite. * * 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; } /* *---------------------------------------------------------------------- * * DupArithSeriesRep -- * * Initialize the internal representation of a ArithSeries abstract list * 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 AbstractList structure. *---------------------------------------------------------------------- */ static void DupArithSeriesRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { ArithSeries *srcArithSeries = (ArithSeries*)Tcl_AbstractListGetConcreteRep(srcPtr); ArithSeries *copyArithSeries = (ArithSeries *)Tcl_Alloc(sizeof(ArithSeries)); *copyArithSeries = *srcArithSeries; /* Note: we do not have to be worry about existing internal rep because copyPtr is supposed to be freshly initialized */ Tcl_AbstractListSetConcreteRep(copyPtr, copyArithSeries); } /* *---------------------------------------------------------------------- * * FreeArithSeriesRep -- * * Free any allocated memory in the ArithSeries Rep * * Results: * None. * * Side effects: * *---------------------------------------------------------------------- */ static void FreeArithSeriesRep(Tcl_Obj *arithSeriesObjPtr) /* Free any allocated memory */ { ArithSeries *arithSeriesPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr); if (arithSeriesPtr) { if (arithSeriesPtr->elements) { Tcl_WideInt i, len = arithSeriesPtr->len; for (i=0; i<len; i++) { Tcl_DecrRefCount(arithSeriesPtr->elements[i]); } Tcl_Free((char*)arithSeriesPtr->elements); arithSeriesPtr->elements = NULL; } Tcl_Free((char*)arithSeriesPtr); } } /* *---------------------------------------------------------------------- * * TclNewArithSeriesInt -- * * Creates a new ArithSeries object. The returned object has |
︙ | ︙ | |||
131 132 133 134 135 136 137 | * 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)); | | < < > | | | > | | | | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | * 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 *arithSeriesObj; ArithSeries *arithSeriesRepPtr; if (length <= 0) { TclNewObj(arithSeriesObj); return arithSeriesObj; } arithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof (ArithSeries)); arithSeriesRepPtr->isDouble = 0; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; arithSeriesRepPtr->step = step; arithSeriesRepPtr->len = length; arithSeriesRepPtr->elements = NULL; arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType); Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr); if (length > 0) Tcl_InvalidateStringRep(arithSeriesObj); return arithSeriesObj; } /* *---------------------------------------------------------------------- * * TclNewArithSeriesDbl -- * |
︙ | ︙ | |||
178 179 180 181 182 183 184 | * None. *---------------------------------------------------------------------- */ Tcl_Obj * TclNewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len) { Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step)); | | < < > | | | > | | | | > > | > > > > > | | | | | | | | 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 | * 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 *arithSeriesObj; ArithSeriesDbl *arithSeriesRepPtr; if (length <= 0) { TclNewObj(arithSeriesObj); return arithSeriesObj; } arithSeriesRepPtr = (ArithSeriesDbl*) Tcl_Alloc(sizeof (ArithSeriesDbl)); arithSeriesRepPtr->isDouble = 1; arithSeriesRepPtr->start = start; arithSeriesRepPtr->end = end; arithSeriesRepPtr->step = step; arithSeriesRepPtr->len = length; arithSeriesRepPtr->elements = NULL; arithSeriesObj = Tcl_AbstractListObjNew(NULL, &arithSeriesType); Tcl_AbstractListSetConcreteRep(arithSeriesObj, arithSeriesRepPtr); if (length > 0) Tcl_InvalidateStringRep(arithSeriesObj); return arithSeriesObj; } /* *---------------------------------------------------------------------- * * assignNumber -- * * Create the approprite 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 (Tcl_GetNumberFromObj(NULL, numberObj, (void**)&number, &tcl_number_type) != TCL_OK || tcl_number_type == TCL_NUMBER_BIG) { 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; } } } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
266 267 268 269 270 271 272 273 274 | * An empty Tcl_Obj if the range is invalid. * * Side Effects: * * None. *---------------------------------------------------------------------- */ int TclNewArithSeriesObj( | > | | | < > | | | | | | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 | * An empty Tcl_Obj if the range is invalid. * * Side Effects: * * None. *---------------------------------------------------------------------- */ int TclNewArithSeriesObj( Tcl_Interp *interp, /* For error reporting */ Tcl_Obj **arithSeriesObj, /* return value */ int useDoubles, /* Promote values to double when true, * int otherwise */ Tcl_Obj *startObj, /* First value in list */ Tcl_Obj *endObj, /* Upper bound value of list */ Tcl_Obj *stepObj, /* Increment amount */ Tcl_Obj *lenObj) /* Number of elements */ { double dstart, dend, dstep; Tcl_WideInt start, end, step; Tcl_WideInt 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) { *arithSeriesObj = Tcl_NewObj(); return TCL_OK; } } if (endObj) { assignNumber(useDoubles, &end, &dend, endObj); } if (lenObj) { if (TCL_OK != Tcl_GetWideIntFromObj(interp, lenObj, &len)) { |
︙ | ︙ | |||
357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 | } return TCL_OK; } /* *---------------------------------------------------------------------- * * 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. *---------------------------------------------------------------------- */ | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | < < | < < < < < | < | < | < < | < < < < < < < < | < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < | < | < > | > | < | | < < < < < | | 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 | } return TCL_OK; } /* *---------------------------------------------------------------------- * * TclArithSeriesObjLength * * Returns the length of the arithmentic series. * * Results: * * The length of the series as Tcl_WideInt. * * Side Effects: * * None. * *---------------------------------------------------------------------- */ Tcl_WideInt TclArithSeriesObjLength(Tcl_Obj *arithSeriesObj) { ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesObj); return arithSeriesRepPtr->len; } /* *---------------------------------------------------------------------- * * TclArithSeriesObjIndex -- * * Returns the element with the specified index in the list * represented by the specified Arithmentic 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 succes, TCL_ERROR on index out of range. * * Side Effects: * * On success, the integer pointed by *element is modified. * *---------------------------------------------------------------------- */ int TclArithSeriesObjIndex( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *arithSeriesPtr, /* List obj */ Tcl_Size index, /* index to element of interest */ Tcl_Obj **elemObj) /* Return value */ { ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr); (void)interp; // quiet compiler if (index < arithSeriesRepPtr->len) { /* List[i] = Start + (Step * index) */ if (arithSeriesRepPtr->isDouble) { *elemObj = Tcl_NewDoubleObj(ArithSeriesIndexDbl((ArithSeriesDbl*)arithSeriesRepPtr, index)); } else { *elemObj = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index)); } } else { TclNewObj(*elemObj); // empty value } return TCL_OK; } /* *---------------------------------------------------------------------- * * 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. *---------------------------------------------------------------------- */ int TclArithSeriesObjStep( Tcl_Obj *arithSeriesPtr, Tcl_Obj **stepObj) { ArithSeries *arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr); if (arithSeriesRepPtr->isDouble) { *stepObj = Tcl_NewDoubleObj(((ArithSeriesDbl*)(arithSeriesRepPtr))->step); } else { *stepObj = Tcl_NewWideIntObj(arithSeriesRepPtr->step); } return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_NewArithSeriesObj -- * * 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 * Tcl_NewArithSeriesObj(Tcl_Size objc, Tcl_Obj * const objv[]) { Tcl_Obj *arithSeriesObj; if (objc != 4) return NULL; // TODO: Define this use model! if (TclNewArithSeriesObj(NULL, &arithSeriesObj, 0/*TODO: int vs double support */, objv[0]/*start*/, objv[1]/*end*/, objv[2]/*step*/, objv[3]/*len*/) != TCL_OK) { arithSeriesObj = NULL; } return arithSeriesObj; } /* *---------------------------------------------------------------------- * * TclArithSeriesObjRange -- * |
︙ | ︙ | |||
699 700 701 702 703 704 705 | * Side effects: * ?The possible conversion of the object referenced by listPtr? * ?to a list object.? * *---------------------------------------------------------------------- */ | < > | | > > | > < < < < | | < < < < < | < | < | < < | < < < | > | | < | > > > < | | < < | | | | | | | 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 | * Side effects: * ?The possible conversion of the object referenced by listPtr? * ?to a list object.? * *---------------------------------------------------------------------- */ int TclArithSeriesObjRange( Tcl_Interp *interp, /* for error messages. */ Tcl_Obj *arithSeriesPtr, /* List object to take a range from. */ Tcl_Size fromIdx, /* Index of first element to include. */ Tcl_Size toIdx, /* Index of last element to include. */ Tcl_Obj **newObjPtr) /* return value */ { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; (void)interp; /* silence compiler */ arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr); if (fromIdx == TCL_INDEX_NONE) { fromIdx = 0; } if (toIdx >= arithSeriesRepPtr->len) { toIdx = arithSeriesRepPtr->len-1; } if (fromIdx > toIdx || fromIdx >= arithSeriesRepPtr->len) { TclNewObj(*newObjPtr); return TCL_OK; } TclArithSeriesObjIndex(interp, arithSeriesPtr, fromIdx, &startObj); Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(interp, arithSeriesPtr, toIdx, &endObj); Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); Tcl_IncrRefCount(stepObj); if (Tcl_IsShared(arithSeriesPtr) || ((arithSeriesPtr->refCount > 1))) { int status = TclNewArithSeriesObj(NULL, newObjPtr, arithSeriesRepPtr->isDouble, startObj, endObj, stepObj, NULL); Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); return status; } /* * In-place is possible. */ /* * Even if nothing below cause any changes, we still want the * string-canonizing effect of [lrange 0 end]. */ TclInvalidateStringRep(arithSeriesPtr); if (arithSeriesRepPtr->isDouble) { ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesPtr; |
︙ | ︙ | |||
798 799 800 801 802 803 804 | arithSeriesRepPtr->elements = NULL; } Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < | < < < < < < < < < < < | < | | > > | > > > > > | | > > > > | | | | | | 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 | arithSeriesRepPtr->elements = NULL; } Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); *newObjPtr = arithSeriesPtr; return TCL_OK; } /* * Handle ArithSeries special case - don't shimmer a series into a list * just to reverse it. */ int TclArithSeriesObjReverse( Tcl_Interp *interp, /* For error messages */ Tcl_Obj *arithSeriesPtr, /* List object to reverse. */ Tcl_Obj **newObjPtr) { ArithSeries *arithSeriesRepPtr; Tcl_Obj *startObj, *endObj, *stepObj; Tcl_Obj *resultObj; Tcl_WideInt start, end, step, len; double dstart, dend, dstep; int isDouble; (void)interp; if (newObjPtr == NULL) { return TCL_ERROR; } arithSeriesRepPtr = (ArithSeries *)Tcl_AbstractListGetConcreteRep(arithSeriesPtr); isDouble = arithSeriesRepPtr->isDouble; len = arithSeriesRepPtr->len; TclArithSeriesObjIndex(NULL, arithSeriesPtr, (len-1), &startObj); Tcl_IncrRefCount(startObj); TclArithSeriesObjIndex(NULL, arithSeriesPtr, 0, &endObj); Tcl_IncrRefCount(endObj); TclArithSeriesObjStep(arithSeriesPtr, &stepObj); Tcl_IncrRefCount(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); } Tcl_IncrRefCount(startObj); Tcl_IncrRefCount(endObj); Tcl_IncrRefCount(stepObj); if (Tcl_IsShared(arithSeriesPtr) || ((arithSeriesPtr->refCount > 1))) { Tcl_Obj *lenObj = Tcl_NewWideIntObj(len); if (TclNewArithSeriesObj(NULL, &resultObj, isDouble, startObj, endObj, stepObj, lenObj) != TCL_OK) { resultObj = NULL; } Tcl_DecrRefCount(lenObj); } else { /* * In-place is possible. */ TclInvalidateStringRep(arithSeriesPtr); |
︙ | ︙ | |||
994 995 996 997 998 999 1000 | resultObj = arithSeriesPtr; } Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 | resultObj = arithSeriesPtr; } Tcl_DecrRefCount(startObj); Tcl_DecrRefCount(endObj); Tcl_DecrRefCount(stepObj); *newObjPtr = resultObj; return TCL_OK; } /* ** Handle ArithSeries GetElements call */ int TclArithSeriesGetElements( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *arithSeriesObjPtr, /* ArithSeries object for which an element * array is to be returned. */ Tcl_Size *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. */ { ArithSeries *arithSeriesRepPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr); Tcl_Obj **objv; int i, objc; objc = arithSeriesRepPtr->len; if (objvPtr == NULL) { if (objcPtr) { *objcPtr = objc; return TCL_OK; } return TCL_ERROR; } if (objc && objvPtr && arithSeriesRepPtr->elements) { objv = arithSeriesRepPtr->elements; } else if (objc > 0) { 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; } for (i = 0; i < objc; i++) { if (TclArithSeriesObjIndex(interp, arithSeriesObjPtr, i, &objv[i]) == TCL_OK) { Tcl_IncrRefCount(objv[i]); } else { // TODO: some cleanup needed here return TCL_ERROR; } } } else { objv = NULL; } arithSeriesRepPtr->elements = objv; *objvPtr = objv; *objcPtr = objc; return TCL_OK; } static void UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObjPtr) { ArithSeries *arithSeriesRepPtr = (ArithSeries*)Tcl_AbstractListGetConcreteRep(arithSeriesObjPtr); char *p, *str; Tcl_Obj *eleObj; Tcl_WideInt length = 0; int llen, slen, i; /* * Pass 1: estimate space. */ llen = arithSeriesRepPtr->len; if (llen <= 0) { Tcl_InitStringRep(arithSeriesObjPtr, NULL, 0); return; } for (i = 0; i < llen; i++) { if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) { Tcl_GetStringFromObj(eleObj, &slen); length += slen + 1; /* one more for the space char */ Tcl_DecrRefCount(eleObj); } else { // TODO: report error? } } /* * Pass 2: generate the string repr. */ p = Tcl_InitStringRep(arithSeriesObjPtr, NULL, length); for (i = 0; i < llen; i++) { if (TclArithSeriesObjIndex(NULL, arithSeriesObjPtr, i, &eleObj) == TCL_OK) { str = Tcl_GetStringFromObj(eleObj, &slen); strcpy(p, str); p[slen] = ' '; p += slen+1; Tcl_DecrRefCount(eleObj); } // else TODO: report error here? } if (length > 0) arithSeriesObjPtr->bytes[length-1] = '\0'; arithSeriesObjPtr->length = length-1; } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclArithSeries.h.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * 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. */ /* | | | > | < < < < < < < < < < < < < < < < < < < | < | | > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | /* * 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 AirthSeries 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_Size len; Tcl_Obj **elements; int isDouble; } ArithSeries; typedef struct ArithSeriesDbl { double start; double end; double step; Tcl_Size len; Tcl_Obj **elements; int isDouble; } ArithSeriesDbl; MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, Tcl_Obj *stepObj, Tcl_Obj *lenObj); /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclBasic.c.
︙ | ︙ | |||
306 307 308 309 310 311 312 | {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, | | | 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 | {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"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}, {"proc", procObjCmd, NULL, NULL, CMD_IS_SAFE}, {"regexp", Tcl_RegexpObjCmd, TclCompileRegexpCmd, NULL, CMD_IS_SAFE}, {"regsub", Tcl_RegsubObjCmd, TclCompileRegsubCmd, NULL, CMD_IS_SAFE}, {"rename", Tcl_RenameObjCmd, NULL, NULL, CMD_IS_SAFE}, |
︙ | ︙ |
Changes to generic/tclCmdAH.c.
︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 | * Copyright © 1994-1997 Sun Microsystems, Inc. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #ifdef _WIN32 # include "tclWinInt.h" #endif | > < | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * Copyright © 1994-1997 Sun Microsystems, Inc. * * 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 "tclAbstractList.h" #ifdef _WIN32 # include "tclWinInt.h" #endif /* * The state structure used by [foreach]. Note that the actual structure has * all its working arrays appended afterwards so they can be allocated and * freed in a single step. */ |
︙ | ︙ | |||
2722 2723 2724 2725 2726 2727 2728 | (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), "NEEDVARS", NULL); result = TCL_ERROR; goto done; } /* Values */ | | | | | < | | 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 | (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), "NEEDVARS", NULL); result = TCL_ERROR; goto done; } /* Values */ if (TclHasInternalRep(objv[2+i*2],&tclAbstractListType)) { /* Special case for Abstract List */ statePtr->aCopyList[i] = Tcl_AbstractListObjCopy(interp, objv[2+i*2]); if (statePtr->aCopyList[i] == NULL) { result = TCL_ERROR; goto done; } /* Don't compute values here, wait until the last momement */ statePtr->argcList[i] = Tcl_AbstractListObjLength(statePtr->aCopyList[i]); } else { 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++; } if (j > statePtr->maxj) { |
︙ | ︙ | |||
2860 2861 2862 2863 2864 2865 2866 | static inline int ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { int i; | | > | > | | > | | | | 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 | static inline int ForeachAssignments( Tcl_Interp *interp, struct ForeachState *statePtr) { int i; Tcl_Size v, k; Tcl_Obj *valuePtr, *varValuePtr; for (i=0 ; i<statePtr->numLists ; i++) { int isAbstractList = TclHasInternalRep(statePtr->aCopyList[i],&tclAbstractListType); for (v=0 ; v<statePtr->varcList[i] ; v++) { k = statePtr->index[i]++; if (k < statePtr->argcList[i]) { if (isAbstractList) { if (Tcl_AbstractListObjIndex(interp, statePtr->aCopyList[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 */ |
︙ | ︙ |
Changes to generic/tclCmdIL.c.
︙ | ︙ | |||
13 14 15 16 17 18 19 20 21 | * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2005 Donal K. Fellows. * * 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 "tclRegexp.h" | > | | | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | * Copyright © 2001 Kevin B. Kenny. All rights reserved. * Copyright © 2005 Donal K. Fellows. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <math.h> #include "tclInt.h" #include "tclRegexp.h" #include "tclAbstractList.h" #include "tclArithSeries.h" #include <assert.h> /* * During execution of the "lsort" command, structures of the following type * are used to arrange the objects being sorted into a collection of linked * lists. */ |
︙ | ︙ | |||
92 93 94 95 96 97 98 | #define SORTMODE_ASCII 0 #define SORTMODE_INTEGER 1 #define SORTMODE_REAL 2 #define SORTMODE_COMMAND 3 #define SORTMODE_DICTIONARY 4 #define SORTMODE_ASCII_NC 8 | < < < < < < < < < < < < < < < < < | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | #define SORTMODE_ASCII 0 #define SORTMODE_INTEGER 1 #define SORTMODE_REAL 2 #define SORTMODE_COMMAND 3 #define SORTMODE_DICTIONARY 4 #define SORTMODE_ASCII_NC 8 /* * Forward declarations for procedures defined in this file: */ static int DictionaryCompare(const char *left, const char *right); static Tcl_NRPostProc IfConditionCallback; static Tcl_ObjCmdProc InfoArgsCmd; |
︙ | ︙ | |||
177 178 179 180 181 182 183 184 185 186 187 188 189 190 | {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* *---------------------------------------------------------------------- * * Tcl_IfObjCmd -- * * This procedure is invoked to process the "if" Tcl command. See the | > > > > > > > > > > > > > > > > > > | 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"sharedlibextension", InfoSharedlibCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"tclversion", InfoTclVersionCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"vars", TclInfoVarsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {NULL, NULL, NULL, NULL, NULL, 0} }; /* * 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; /* *---------------------------------------------------------------------- * * Tcl_IfObjCmd -- * * This procedure is invoked to process the "if" Tcl command. See the |
︙ | ︙ | |||
2196 2197 2198 2199 2200 2201 2202 | int Tcl_JoinObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { | | < | < | > | | | > > > | > > | > | | | | < < < < | | | | | | | | | | < < < < < < < < < < < < < < < < < < | < | 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 2208 2209 2210 2211 2212 2213 2214 2215 2216 2217 2218 2219 2220 2221 2222 2223 2224 2225 2226 2227 2228 2229 2230 2231 2232 2233 2234 2235 2236 2237 2238 2239 2240 2241 2242 2243 2244 2245 2246 2247 2248 2249 2250 2251 2252 2253 2254 2255 2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276 2277 2278 2279 | int Tcl_JoinObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* The argument objects. */ { size_t length, listLen, isAbstractList = 0; Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs; if ((objc < 2) || (objc > 3)) { Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?"); return TCL_ERROR; } /* * Make sure the list argument is a list object and get its length and a * pointer to its array of element pointers. */ if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) { listLen = Tcl_AbstractListObjLength(objv[1]); isAbstractList = (listLen ? 1 : 0); if (listLen > 1 && Tcl_AbstractListObjGetElements(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } } else if (TclListObjGetElementsM(interp, objv[1], &listLen, &elemPtrs) != TCL_OK) { return TCL_ERROR; } if (listLen == 0) { /* No elements to join; default empty result is correct. */ return TCL_OK; } if (listLen == 1) { /* One element; return it */ if (!isAbstractList) { Tcl_SetObjResult(interp, elemPtrs[0]); } else { Tcl_Obj *elemObj; if (Tcl_AbstractListObjIndex(interp, objv[1], 0, &elemObj) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, elemObj); } return TCL_OK; } joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2]; Tcl_IncrRefCount(joinObjPtr); (void) Tcl_GetStringFromObj(joinObjPtr, &length); if (length == 0) { resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0); } else { size_t i; resObjPtr = Tcl_NewObj(); 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); } Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]); } } Tcl_DecrRefCount(joinObjPtr); if (resObjPtr) { Tcl_SetObjResult(interp, resObjPtr); return TCL_OK; } |
︙ | ︙ | |||
2718 2719 2720 2721 2722 2723 2724 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; | | | 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 | TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; Tcl_Size listLen, first, last; if (objc != 4) { Tcl_WrongNumArgs(interp, 1, objv, "list first last"); return TCL_ERROR; } result = TclListObjLengthM(interp, objv[1], &listLen); if (result != TCL_OK) { |
︙ | ︙ | |||
2741 2742 2743 2744 2745 2746 2747 | result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, &last); if (result != TCL_OK) { return result; } | | | | | | < < > | 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 | result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1, &last); if (result != TCL_OK) { return result; } if (TclAbstractListHasProc(objv[1], TCL_ABSL_SLICE)) { Tcl_Obj *resultObj; int status = Tcl_AbstractListObjRange(interp, objv[1], first, last, &resultObj); if (status == TCL_OK) { Tcl_SetObjResult(interp, resultObj); } return status; } else { Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last)); } return TCL_OK; } /* |
︙ | ︙ | |||
3135 3136 3137 3138 3139 3140 3141 | Tcl_Obj **elemv; size_t elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } | < | | | | | > | < < | < | 3118 3119 3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130 3131 3132 3133 3134 3135 3136 3137 3138 3139 3140 3141 3142 3143 3144 | Tcl_Obj **elemv; size_t elemc, i, j; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "list"); return TCL_ERROR; } /* * Handle AbstractList special case - do not shimmer into a list, if it * supports a private Reverse function, just to reverse it. */ if (TclAbstractListHasProc(objv[1], TCL_ABSL_REVERSE)) { Tcl_Obj *resultObj; if (Tcl_AbstractListObjReverse(interp, objv[1], &resultObj) == TCL_OK) { Tcl_SetObjResult(interp, resultObj); return TCL_OK; } } /* end Abstract List */ if (TclListObjGetElementsM(interp, objv[1], &elemc, &elemv) != TCL_OK) { return TCL_ERROR; } /* * If the list is empty, just return it. [Bug 1876793] */ |
︙ | ︙ | |||
3970 3971 3972 3973 3974 3975 3976 | } return result; } /* *---------------------------------------------------------------------- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 3950 3951 3952 3953 3954 3955 3956 3957 3958 3959 3960 3961 3962 3963 | } return result; } /* *---------------------------------------------------------------------- * * SequenceIdentifyArgument -- * (for [lseq] command) * * Given a Tcl_Obj, identify if it is a keyword or a number * * Return Value * 0 - failure, unexpected value |
︙ | ︙ | |||
4080 4081 4082 4083 4084 4085 4086 | Tcl_Obj *argPtr, /* Argument to decode */ Tcl_Obj **numValuePtr, /* Return numeric value */ int *keywordIndexPtr) /* Return keyword enum */ { int status; SequenceOperators opmode; SequenceByMode bymode; | > > > | | | 3975 3976 3977 3978 3979 3980 3981 3982 3983 3984 3985 3986 3987 3988 3989 3990 3991 3992 3993 3994 | 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 = Tcl_GetNumberFromObj(NULL, argPtr, (void**)&nvalue, keywordIndexPtr); if (status == TCL_OK) { if (numValuePtr) { *numValuePtr = argPtr; } return NumericArg; } else { /* Check for an index expression */ |
︙ | ︙ | |||
4192 4193 4194 4195 4196 4197 4198 | 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; | | | 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 | 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 = TCL_ERROR, 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); |
︙ | ︙ | |||
4262 4263 4264 4265 4266 4267 4268 | */ switch (arg_key) { /* No argument */ case 0: Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); | < | | | | | | < | | < < | < | | < < < < < | < < | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 4327 4328 4329 4330 4331 4332 4333 4334 4335 4336 4337 4338 4339 4340 4341 4342 4343 4344 4345 4346 4347 4348 4349 4350 4351 4352 4353 4354 4355 4356 4357 4358 4359 4360 4361 4362 4363 4364 4365 4366 4367 4368 4369 4370 4371 4372 4373 4374 4375 4376 4377 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 4393 4394 4395 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 | */ switch (arg_key) { /* No argument */ case 0: Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); goto done; break; /* lseq n */ case 1: start = zero; elementCount = numValues[0]; end = NULL; step = one; break; /* lseq n n */ case 11: start = numValues[0]; end = numValues[1]; break; /* lseq n n n */ case 111: start = numValues[0]; end = numValues[1]; step = numValues[2]; break; /* lseq n 'to' n */ /* lseq n 'count' n */ /* lseq 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: goto done; } break; /* lseq n 'to' n n */ /* lseq 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 */ goto done; break; default: goto done; break; } break; /* lseq 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: goto done; break; } break; /* lseq n 'to' n 'by' n */ /* lseq n 'count' n 'by' n */ case 12121: start = numValues[0]; opmode = (SequenceOperators)values[3]; switch (opmode) { case LSEQ_BY: step = numValues[4]; break; default: 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: 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: 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; } goto done; break; /* All other argument errors */ default: Tcl_WrongNumArgs(interp, 1, objv, "n ??op? n ??by? n??"); goto done; break; } /* * Success! Now lets create the series object. */ status = TclNewArithSeriesObj(interp, &arithSeriesPtr, useDoubles, start, end, step, elementCount); if (status == TCL_OK) { Tcl_SetObjResult(interp, arithSeriesPtr); } 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_LsetObjCmd -- * * This procedure is invoked to process the "lset" Tcl command. See the * user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * See the user documentation. * *---------------------------------------------------------------------- */ int Tcl_LsetObjCmd( TCL_UNUSED(ClientData), Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument values. */ { Tcl_Obj *listPtr; /* Pointer to the list being altered. */ Tcl_Obj *finalValuePtr; /* Value finally assigned to the variable. */ /* * Check parameter count. */ if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, "listVar ?index? ?index ...? value"); return TCL_ERROR; } /* * Look up the list variable's value. */ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG); if (listPtr == NULL) { return TCL_ERROR; } /* * Substitute the value in the value. Return either the value or else an * unshared copy of it. */ if (objc == 4) { finalValuePtr = TclLsetList(interp, listPtr, objv[2], objv[3]); } else { if (TclAbstractListHasProc(listPtr, TCL_ABSL_SETELEMENT)) { finalValuePtr = Tcl_AbstractListSetElement(interp, listPtr, objc-3, objv+2, objv[objc-1]); if (finalValuePtr) { Tcl_IncrRefCount(finalValuePtr); } } else { finalValuePtr = TclLsetFlat(interp, listPtr, objc-3, objv+2, objv[objc-1]); } } /* * If substitution has failed, bail out. */ if (finalValuePtr == NULL) { return TCL_ERROR; } /* * Finally, update the variable so that traces fire. */ listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, finalValuePtr, TCL_LEAVE_ERR_MSG); Tcl_DecrRefCount(finalValuePtr); if (listPtr == NULL) { return TCL_ERROR; } /* * Return the new value of the variable as the interpreter result. */ Tcl_SetObjResult(interp, listPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * Tcl_LsortObjCmd -- * * This procedure is invoked to process the "lsort" Tcl command. See the |
︙ | ︙ | |||
4723 4724 4725 4726 4727 4728 4729 | sortInfo.resultCode = TCL_ERROR; goto done; } Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj()); sortInfo.compareCmdPtr = newCommandPtr; } | | | | | 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 | sortInfo.resultCode = TCL_ERROR; goto done; } Tcl_ListObjAppendElement(interp, newCommandPtr, Tcl_NewObj()); sortInfo.compareCmdPtr = newCommandPtr; } if (TclAbstractListHasProc(objv[1], TCL_ABSL_GETELEMENTS)) { sortInfo.resultCode = Tcl_AbstractListObjGetElements(interp, listObj, &length, &listObjPtrs); } else { sortInfo.resultCode = TclListObjGetElementsM(interp, listObj, &length, &listObjPtrs); } if (sortInfo.resultCode != TCL_OK || length <= 0) { goto done; } |
︙ | ︙ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 | size_t numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 | size_t numBytes, void **clientDataPtr, int *typePtr); /* 682 */ EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 683 */ EXTERN int Tcl_GetEncodingNulLength(Tcl_Encoding encoding); /* 684 */ EXTERN Tcl_AbstractListType * Tcl_AbstractListGetType(Tcl_Obj *objPtr); /* 685 */ EXTERN Tcl_Obj * Tcl_AbstractListObjNew(Tcl_Interp *interp, const Tcl_AbstractListType*vTablePtr); /* 686 */ EXTERN Tcl_WideInt Tcl_AbstractListObjLength(Tcl_Obj *abstractListPtr); /* 687 */ EXTERN int Tcl_AbstractListObjIndex(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr); /* 688 */ EXTERN int Tcl_AbstractListObjRange(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); /* 689 */ EXTERN int Tcl_AbstractListObjReverse(Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr); /* 690 */ EXTERN int Tcl_AbstractListObjGetElements(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 691 */ EXTERN Tcl_Obj * Tcl_AbstractListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); /* 692 */ EXTERN void * Tcl_AbstractListGetConcreteRep(Tcl_Obj *objPtr); /* 693 */ EXTERN Tcl_Obj * Tcl_AbstractListSetElement(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; |
︙ | ︙ | |||
2541 2542 2543 2544 2545 2546 2547 2548 2549 2550 2551 2552 2553 2554 | 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 */ int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif | > > > > > > > > > > | 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 | 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 */ int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */ int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ Tcl_AbstractListType * (*tcl_AbstractListGetType) (Tcl_Obj *objPtr); /* 684 */ Tcl_Obj * (*tcl_AbstractListObjNew) (Tcl_Interp *interp, const Tcl_AbstractListType*vTablePtr); /* 685 */ Tcl_WideInt (*tcl_AbstractListObjLength) (Tcl_Obj *abstractListPtr); /* 686 */ int (*tcl_AbstractListObjIndex) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size index, Tcl_Obj **elemObjPtr); /* 687 */ int (*tcl_AbstractListObjRange) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); /* 688 */ int (*tcl_AbstractListObjReverse) (Tcl_Interp *interp, Tcl_Obj *abstractListPtr, Tcl_Obj **newObjPtr); /* 689 */ int (*tcl_AbstractListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 690 */ Tcl_Obj * (*tcl_AbstractListObjCopy) (Tcl_Interp *interp, Tcl_Obj *listPtr); /* 691 */ void * (*tcl_AbstractListGetConcreteRep) (Tcl_Obj *objPtr); /* 692 */ Tcl_Obj * (*tcl_AbstractListSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size indexCount, Tcl_Obj *const indexArray[], Tcl_Obj *valueObj); /* 693 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
3861 3862 3863 3864 3865 3866 3867 3868 3869 3870 3871 3872 3873 3874 | (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ (tclStubsPtr->tcl_GetNumber) /* 681 */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef _WIN32 # undef Tcl_CreateFileHandler | > > > > > > > > > > > > > > > > > > > > | 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 3920 3921 3922 3923 3924 3925 3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 | (tclStubsPtr->tcl_GetNumberFromObj) /* 680 */ #define Tcl_GetNumber \ (tclStubsPtr->tcl_GetNumber) /* 681 */ #define Tcl_RemoveChannelMode \ (tclStubsPtr->tcl_RemoveChannelMode) /* 682 */ #define Tcl_GetEncodingNulLength \ (tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */ #define Tcl_AbstractListGetType \ (tclStubsPtr->tcl_AbstractListGetType) /* 684 */ #define Tcl_AbstractListObjNew \ (tclStubsPtr->tcl_AbstractListObjNew) /* 685 */ #define Tcl_AbstractListObjLength \ (tclStubsPtr->tcl_AbstractListObjLength) /* 686 */ #define Tcl_AbstractListObjIndex \ (tclStubsPtr->tcl_AbstractListObjIndex) /* 687 */ #define Tcl_AbstractListObjRange \ (tclStubsPtr->tcl_AbstractListObjRange) /* 688 */ #define Tcl_AbstractListObjReverse \ (tclStubsPtr->tcl_AbstractListObjReverse) /* 689 */ #define Tcl_AbstractListObjGetElements \ (tclStubsPtr->tcl_AbstractListObjGetElements) /* 690 */ #define Tcl_AbstractListObjCopy \ (tclStubsPtr->tcl_AbstractListObjCopy) /* 691 */ #define Tcl_AbstractListGetConcreteRep \ (tclStubsPtr->tcl_AbstractListGetConcreteRep) /* 692 */ #define Tcl_AbstractListSetElement \ (tclStubsPtr->tcl_AbstractListSetElement) /* 693 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #ifdef _WIN32 # undef Tcl_CreateFileHandler |
︙ | ︙ |
Changes to generic/tclExecute.c.
︙ | ︙ | |||
15 16 17 18 19 20 21 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" #include "tclTomMath.h" | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include "tclCompile.h" #include "tclOOInt.h" #include "tclTomMath.h" #include "tclAbstractList.h" #include <math.h> #include <assert.h> /* * Hack to determine whether we may expect IEEE floating point. The hack is * formally incorrect in that non-IEEE platforms might have the same precision * and range, but VAX, IBM, and Cray do not; are there any other floating |
︙ | ︙ | |||
4653 4654 4655 4656 4657 4658 4659 | NEXT_INST_F(1, 1, 1); case INST_LIST_INDEX: /* lindex with objc == 3 */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); | < | | | | > | 4653 4654 4655 4656 4657 4658 4659 4660 4661 4662 4663 4664 4665 4666 4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 4681 4682 4683 4684 4685 4686 4687 4688 | NEXT_INST_F(1, 1, 1); case INST_LIST_INDEX: /* lindex with objc == 3 */ value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* special case for AbstractList */ if (TclHasInternalRep(valuePtr,&tclAbstractListType)) { length = Tcl_AbstractListObjLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } Tcl_IncrRefCount(objResultPtr); // reference held here goto lindexDone; } /* * Extract the desired list element. */ /* TODO: handle AbstractList here? */ if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK) && !TclHasInternalRep(value2Ptr, &tclListType)) { int code; DECACHE_STACK_INFO(); code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index); CACHE_STACK_INFO(); |
︙ | ︙ | |||
4717 4718 4719 4720 4721 4722 4723 | * Pop the list and get the index. */ valuePtr = OBJ_AT_TOS; opnd = TclGetInt4AtPtr(pc+1); TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd)); | > > > > > | | | < < | | | | | < < | < < < < | | 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 4740 4741 4742 4743 4744 4745 4746 4747 4748 4749 4750 4751 4752 4753 4754 | * Pop the list and get the index. */ valuePtr = OBJ_AT_TOS; opnd = TclGetInt4AtPtr(pc+1); TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd)); /* * Get the contents of the list, making sure that it really is a list * in the process. */ /* special case for AbstractList */ if (TclHasInternalRep(valuePtr,&tclAbstractListType)) { length = Tcl_AbstractListObjLength(valuePtr); /* Decode end-offset index values. */ index = TclIndexDecode(opnd, length-1); /* Compute value @ index */ if (Tcl_AbstractListObjIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) { CACHE_STACK_INFO(); TRACE_ERROR(interp); goto gotError; } pcAdjustment = 5; goto lindexFastPath2; } /* List case */ if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } /* Decode end-offset index values. */ |
︙ | ︙ | |||
4816 4817 4818 4819 4820 4821 4822 | valuePtr = POP_OBJECT(); Tcl_DecrRefCount(valuePtr); /* This one should be done here */ /* * Compute the new variable value. */ | > > > > > | > | 4813 4814 4815 4816 4817 4818 4819 4820 4821 4822 4823 4824 4825 4826 4827 4828 4829 4830 4831 4832 4833 4834 | valuePtr = POP_OBJECT(); Tcl_DecrRefCount(valuePtr); /* This one should be done here */ /* * Compute the new variable value. */ if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) { objResultPtr = Tcl_AbstractListSetElement(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { TRACE_ERROR(interp); goto gotError; } /* * Set result. |
︙ | ︙ | |||
4938 4939 4940 4941 4942 4943 4944 | */ if (fromIdx == TCL_INDEX_NONE) { fromIdx = TCL_INDEX_START; } fromIdx = TclIndexDecode(fromIdx, objc - 1); | | | < | 4941 4942 4943 4944 4945 4946 4947 4948 4949 4950 4951 4952 4953 4954 4955 4956 | */ if (fromIdx == TCL_INDEX_NONE) { fromIdx = TCL_INDEX_START; } fromIdx = TclIndexDecode(fromIdx, objc - 1); if (TclAbstractListHasProc(valuePtr, TCL_ABSL_SLICE)) { if (Tcl_AbstractListObjRange(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } } else { objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx); } |
︙ | ︙ | |||
4966 4967 4968 4969 4970 4971 4972 | TRACE_ERROR(interp); goto gotError; } match = 0; if (length > 0) { size_t i = 0; Tcl_Obj *o; | | > | | > > > | | 4968 4969 4970 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 4986 4987 4988 4989 4990 4991 4992 4993 4994 4995 4996 4997 4998 4999 5000 5001 5002 5003 5004 5005 5006 | TRACE_ERROR(interp); goto gotError; } match = 0; if (length > 0) { size_t i = 0; Tcl_Obj *o; int isAbstractList = TclHasInternalRep(value2Ptr,&tclAbstractListType); /* * An empty list doesn't match anything. */ do { if (isAbstractList) { if (Tcl_AbstractListObjIndex(interp, value2Ptr, i, &o) != TCL_OK) { TRACE_ERROR(interp); goto gotError; } } else { Tcl_ListObjIndex(NULL, value2Ptr, i, &o); } if (o != NULL) { s2 = Tcl_GetStringFromObj(o, &s2len); } else { s2 = ""; s2len = 0; } if (s1len == s2len) { match = (memcmp(s1, s2, s1len) == 0); } if (isAbstractList) { TclDecrRefCount(o); } i++; } while (i < length && match == 0); } if (*pc == INST_LIST_NOT_IN) { |
︙ | ︙ |
Changes to generic/tclInt.h.
︙ | ︙ | |||
2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 | (((listObj_)->typePtr == &tclListType) \ ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. */ #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ | > > > > > > > > > > > > > | 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 | (((listObj_)->typePtr == &tclListType) \ ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0) static inline void Tcl_AbstractListSetType(Tcl_Obj* abstractListObjPtr, void* ptr) { abstractListObjPtr->internalRep.twoPtrValue.ptr2 = ptr; } static inline Tcl_WideInt AbstractListObjLength(Tcl_Obj* abstractListObjPtr) { Tcl_AbstractListType *typePtr = Tcl_AbstractListGetType(abstractListObjPtr); return typePtr->lengthProc(abstractListObjPtr); } /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. */ #define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ #define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ |
︙ | ︙ | |||
2878 2879 2880 2881 2882 2883 2884 | MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; MODULE_SCOPE const Tcl_ObjType tclByteCodeType; MODULE_SCOPE const Tcl_ObjType tclDoubleType; MODULE_SCOPE const Tcl_ObjType tclIntType; MODULE_SCOPE const Tcl_ObjType tclListType; | | | | 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 | MODULE_SCOPE const Tcl_ObjType tclBignumType; MODULE_SCOPE const Tcl_ObjType tclBooleanType; 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 tclDictType; MODULE_SCOPE const Tcl_ObjType tclAbstractListType; MODULE_SCOPE const Tcl_ObjType tclProcBodyType; MODULE_SCOPE const Tcl_ObjType tclStringType; MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType; MODULE_SCOPE const Tcl_ObjType tclRegexpType; MODULE_SCOPE Tcl_ObjType tclCmdNameType; /* |
︙ | ︙ | |||
4667 4668 4669 4670 4671 4672 4673 4674 4675 4676 4677 4678 4679 4680 | #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) #define TclHasInternalRep(objPtr, type) \ ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 4680 4681 4682 4683 4684 4685 4686 4687 4688 4689 4690 4691 4692 4693 4694 4695 4696 4697 4698 4699 4700 4701 4702 4703 4704 4705 4706 4707 4708 4709 4710 4711 4712 4713 4714 4715 4716 4717 4718 4719 4720 4721 4722 4723 4724 4725 4726 4727 4728 4729 | #define TclIsPureDict(objPtr) \ (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType)) #define TclHasInternalRep(objPtr, type) \ ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) static inline int TclAbstractListHasProc(Tcl_Obj* abstractListObjPtr, Tcl_AbstractListProcType ptype) { Tcl_AbstractListType *typePtr; if ( ! TclHasInternalRep(abstractListObjPtr,&tclAbstractListType)) { return 0; } typePtr = Tcl_AbstractListGetType(abstractListObjPtr); switch (ptype) { case TCL_ABSL_NEW: return (typePtr->newObjProc != NULL); case TCL_ABSL_DUPREP: return (typePtr->dupRepProc != NULL); case TCL_ABSL_LENGTH: return (typePtr->lengthProc != NULL); case TCL_ABSL_INDEX: return (typePtr->indexProc != NULL); case TCL_ABSL_SLICE: return (typePtr->sliceProc != NULL); case TCL_ABSL_REVERSE: return (typePtr->reverseProc != NULL); case TCL_ABSL_GETELEMENTS: return (typePtr->getElementsProc != NULL); case TCL_ABSL_FREEREP: return (typePtr->freeRepProc != NULL); case TCL_ABSL_TOSTRING: return (typePtr->toStringProc != NULL); case TCL_ABSL_SETELEMENT: return (typePtr->setElementProc != NULL); case TCL_ABSL_REPLACE: return (typePtr->replaceProc != NULL); } return 0; } /* *---------------------------------------------------------------- * Macro used by the Tcl core to compare Unicode strings. On big-endian * systems we can use the more efficient memcmp, but this would not be * lexically correct on little-endian systems. The ANSI C "prototype" for * this macro is: |
︙ | ︙ | |||
4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 | */ MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit; MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init; MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern); | > | 4775 4776 4777 4778 4779 4780 4781 4782 4783 4784 4785 4786 4787 4788 4789 | */ MODULE_SCOPE Tcl_LibraryInitProc TclplatformtestInit; MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init; MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters * special to [string match]. The ANSI C "prototype" for this macro is: * * MODULE_SCOPE int TclMatchIsTrivial(const char *pattern); |
︙ | ︙ |
Changes to generic/tclListObj.c.
1 2 3 4 5 6 7 8 9 10 11 12 13 | /* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * * Copyright © 2022 Ashok P. Nadkarni. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include <assert.h> #include "tclInt.h" | > < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 | /* * tclListObj.c -- * * This file contains functions that implement the Tcl list object type. * * Copyright © 2022 Ashok P. Nadkarni. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclAbstractList.h" #include <assert.h> #include "tclInt.h" /* * TODO - memmove is fast. Measure at what size we should prefer memmove * (for unshared objects only) in lieu of range operations. On the other * hand, more cache dirtied? */ |
︙ | ︙ | |||
1362 1363 1364 1365 1366 1367 1368 | Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj) /* List object for which an element array is * to be returned. */ { Tcl_Obj *copyObj; if (!TclHasInternalRep(listObj, &tclListType)) { | | | | 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 | Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj) /* List object for which an element array is * to be returned. */ { Tcl_Obj *copyObj; if (!TclHasInternalRep(listObj, &tclListType)) { if (TclHasInternalRep(listObj,&tclAbstractListType)) { return Tcl_AbstractListObjCopy(interp, listObj); } if (SetListFromAny(interp, listObj) != TCL_OK) { return NULL; } } TclNewObj(copyObj); |
︙ | ︙ | |||
1658 1659 1660 1661 1662 1663 1664 | Tcl_Size *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. */ { ListRep listRep; | | | < | | > > > > > > > | > | 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 | Tcl_Size *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. */ { ListRep listRep; if (TclAbstractListHasProc(objPtr, TCL_ABSL_GETELEMENTS) && Tcl_AbstractListObjGetElements(interp, objPtr, objcPtr, objvPtr) == TCL_OK) { return TCL_OK; } else if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK) { int length; (void) Tcl_GetStringFromObj(objPtr, &length); if (length == 0) { *objcPtr = 0; *objvPtr = NULL; return TCL_OK; } return TCL_ERROR; } ListRepElements(&listRep, *objcPtr, *objvPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1988 1989 1990 1991 1992 1993 1994 | Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj, /* List object whose #elements to return. */ Tcl_Size *lenPtr) /* The resulting int is stored here. */ { ListRep listRep; | > | > | | 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 | Tcl_ListObjLength( Tcl_Interp *interp, /* Used to report errors if not NULL. */ Tcl_Obj *listObj, /* List object whose #elements to return. */ Tcl_Size *lenPtr) /* The resulting int is stored here. */ { ListRep listRep; /* Handle AbstractList before attempting SetListFromAny */ if (!TclHasInternalRep(listObj, &tclListType) && TclHasInternalRep(listObj, &tclAbstractListType)) { *lenPtr = Tcl_AbstractListObjLength(listObj); return TCL_OK; } /* * TODO * Unlike the original list code, this does not optimize for lindex'ing * an empty string when the internal rep is not already a list. On the |
︙ | ︙ | |||
2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 | ptrdiff_t tailShift; Tcl_Obj **listObjs; int favor; if (Tcl_IsShared(listObj)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) return TCL_ERROR; /* Cannot be converted to a list */ /* TODO - will need modification if Tcl9 sticks to unsigned indices */ /* Make limits sane */ | > > > > > | 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 | ptrdiff_t tailShift; Tcl_Obj **listObjs; int favor; if (Tcl_IsShared(listObj)) { Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace"); } if (TclAbstractListHasProc(listObj, TCL_ABSL_REPLACE)) { return Tcl_AbstractListObjReplace(interp, listObj, first, numToDelete, numToInsert, insertObjs); } if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) return TCL_ERROR; /* Cannot be converted to a list */ /* TODO - will need modification if Tcl9 sticks to unsigned indices */ /* Make limits sane */ |
︙ | ︙ | |||
2620 2621 2622 2623 2624 2625 2626 | Tcl_Obj *listObj, /* Tcl object representing the list. */ Tcl_Size indexCount, /* Count of indices. */ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that * represent the indices in the list. */ { Tcl_Size i; | | | | | > > > | | 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 | Tcl_Obj *listObj, /* Tcl object representing the list. */ Tcl_Size indexCount, /* Count of indices. */ Tcl_Obj *const indexArray[])/* Array of pointers to Tcl objects that * represent the indices in the list. */ { Tcl_Size i; /* Handle AbstractList as special case */ if (TclHasInternalRep(listObj,&tclAbstractListType)) { Tcl_WideInt listLen = Tcl_AbstractListObjLength(listObj); Tcl_Size index; 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) { if (Tcl_AbstractListObjIndex(interp, listObj, index, &elemObj) != TCL_OK) { return NULL; } } else if (index > 0) { // TODO: support nested lists // For now, only support 1 index, which is all an ArithSeries has Tcl_DecrRefCount(elemObj); TclNewObj(elemObj); break; } } Tcl_IncrRefCount(elemObj); return elemObj; |
︙ | ︙ | |||
2739 2740 2741 2742 2743 2744 2745 | /* * Determine whether the index arg designates a list or a single index. * We have to be careful about the order of the checks to avoid repeated * shimmering; see TIP #22 and #23 for details. */ | | | | > > > > > > > > > | | | > > > > > > | | > > > > | | | < < < > | > > | 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 | /* * Determine whether the index arg designates a list or a single index. * We have to be careful about the order of the checks to avoid repeated * shimmering; see TIP #22 and #23 for details. */ if (!TclHasInternalRep(indexArgObj, &tclListType) && TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index) == TCL_OK) { if (TclAbstractListHasProc(listObj, TCL_ABSL_SETELEMENT)) { indices = &indexArgObj; Tcl_Obj *returnValue = Tcl_AbstractListSetElement(interp, listObj, 1, indices, valueObj); if (returnValue) Tcl_IncrRefCount(returnValue); return returnValue; } /* indexArgPtr designates a single index. */ /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */ return TclLsetFlat(interp, listObj, 1, &indexArgObj, valueObj); } /* * Make copy to not shimmer index argument */ indexListCopy = TclListObjCopy(NULL, indexArgObj); if (indexListCopy == NULL) { /* * indexArgPtr designates something that is neither an index nor a * well formed list. Report the error via TclLsetFlat. */ indexCount = 1; indices = &indexArgObj; } else { /* * Expand list into indicies array */ LIST_ASSERT_TYPE(indexListCopy); ListObjGetElements(indexListCopy, indexCount, indices); } retValueObj = TclLsetFlat(interp, listObj, indexCount, indices, valueObj); if (indexListCopy) { Tcl_DecrRefCount(indexListCopy); } return retValueObj; } /* *---------------------------------------------------------------------- * * TclLsetFlat -- |
︙ | ︙ | |||
3269 3270 3271 3272 3273 3274 3275 | while (!done) { *elemPtrs++ = keyPtr; *elemPtrs++ = valuePtr; Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } | | > | < < < < | < | < < < < | > > | | | > > > > > | 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 3323 3324 3325 3326 3327 3328 3329 3330 3331 3332 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 | while (!done) { *elemPtrs++ = keyPtr; *elemPtrs++ = valuePtr; Tcl_IncrRefCount(keyPtr); Tcl_IncrRefCount(valuePtr); Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); } } else if (TclHasInternalRep(objPtr,&tclAbstractListType)) { Tcl_Size elemCount, i; elemCount = Tcl_AbstractListObjLength(objPtr); if (ListRepInitAttempt(interp, elemCount, NULL, &listRep) != TCL_OK) { return TCL_ERROR; } LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */ LIST_ASSERT(listRep.storePtr->firstUsed == 0); elemPtrs = listRep.storePtr->slots; /* Each iteration, store a list element */ for (i = 0; i < elemCount; i++) { if (Tcl_AbstractListObjIndex(interp, objPtr, i, elemPtrs) != TCL_OK) { return TCL_ERROR; } Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */ } LIST_ASSERT((Tcl_Size)(elemPtrs - listRep.storePtr->slots) == elemCount); listRep.storePtr->numUsed = elemCount; } else { Tcl_Size estCount, length; const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length); /* * Allocate enough space to hold a (Tcl_Obj *) for each |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 22 23 24 25 | * * 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 "tclTomMath.h" #include <math.h> #include <assert.h> /* * Table of all object types. */ | > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | * * 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 "tclTomMath.h" #include "tclAbstractList.h" #include <math.h> #include <assert.h> /* * Table of all object types. */ |
︙ | ︙ | |||
365 366 367 368 369 370 371 372 373 374 375 376 377 378 | Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclCmdNameType); Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; { int i; | > > > > > > > > > > > | 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 | Tcl_RegisterObjType(&tclListType); Tcl_RegisterObjType(&tclDictType); Tcl_RegisterObjType(&tclByteCodeType); Tcl_RegisterObjType(&tclCmdNameType); Tcl_RegisterObjType(&tclRegexpType); Tcl_RegisterObjType(&tclProcBodyType); /* For backward compatibility only ... */ #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 Tcl_RegisterObjType(&tclIntType); #if !defined(TCL_WIDE_INT_IS_LONG) Tcl_RegisterObjType(&oldIntType); #endif Tcl_RegisterObjType(&oldBooleanType); #endif Tcl_RegisterObjType(&tclAbstractListType); #ifdef TCL_COMPILE_STATS Tcl_MutexLock(&tclObjMutex); tclObjsAlloced = 0; tclObjsFreed = 0; { int i; |
︙ | ︙ | |||
4409 4410 4411 4412 4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 | Tcl_RepresentationCmd( TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *descObj; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } /* * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u," " object pointer at %p", | > > > > > > > | | 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 4436 4437 4438 4439 4440 4441 4442 4443 4444 4445 4446 4447 4448 4449 4450 4451 4452 4453 4454 4455 4456 | Tcl_RepresentationCmd( TCL_UNUSED(void *), Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { Tcl_Obj *descObj; const char *typeName; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); return TCL_ERROR; } typeName = (TclHasInternalRep(objv[1],&tclAbstractListType) ? Tcl_AbstractListTypeName(objv[1]) : (objv[1]->typePtr ? objv[1]->typePtr->name : "pure string")); /* * Value is a bignum with a refcount of 14, object pointer at 0x12345678, * internal representation 0x45671234:0x98765432, string representation * "1872361827361287" */ descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u," " object pointer at %p", objv[1]->typePtr ? typeName : "pure string", objv[1]->refCount, objv[1]); if (objv[1]->typePtr) { if (objv[1]->typePtr == &tclDoubleType) { Tcl_AppendPrintfToObj(descObj, ", internal representation %g", objv[1]->internalRep.doubleValue); } else { |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 | Tcl_CreateObjTrace2, /* 677 */ Tcl_NRCreateCommand2, /* 678 */ Tcl_NRCallObjProc2, /* 679 */ Tcl_GetNumberFromObj, /* 680 */ Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ }; /* !END!: Do not edit above this line. */ | > > > > > > > > > > | 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 | Tcl_CreateObjTrace2, /* 677 */ Tcl_NRCreateCommand2, /* 678 */ Tcl_NRCallObjProc2, /* 679 */ Tcl_GetNumberFromObj, /* 680 */ Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ Tcl_AbstractListGetType, /* 684 */ Tcl_AbstractListObjNew, /* 685 */ Tcl_AbstractListObjLength, /* 686 */ Tcl_AbstractListObjIndex, /* 687 */ Tcl_AbstractListObjRange, /* 688 */ Tcl_AbstractListObjReverse, /* 689 */ Tcl_AbstractListObjGetElements, /* 690 */ Tcl_AbstractListObjCopy, /* 691 */ Tcl_AbstractListGetConcreteRep, /* 692 */ Tcl_AbstractListSetElement, /* 693 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
732 733 734 735 736 737 738 739 740 741 742 743 744 745 | return TCL_ERROR; } #if TCL_THREADS if (TclThread_Init(interp) != TCL_OK) { return TCL_ERROR; } #endif /* * Check for special options used in ../tests/main.test */ objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); if (objPtr != NULL) { | > > > > | 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 | return TCL_ERROR; } #if TCL_THREADS if (TclThread_Init(interp) != TCL_OK) { return TCL_ERROR; } #endif if (Tcl_ABSListTest_Init(interp) != TCL_OK) { return TCL_ERROR; } /* * Check for special options used in ../tests/main.test */ objPtr = Tcl_GetVar2Ex(interp, "argv", NULL, TCL_GLOBAL_ONLY); if (objPtr != NULL) { |
︙ | ︙ | |||
8295 8296 8297 8298 8299 8300 8301 | * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ | < | 8299 8300 8301 8302 8303 8304 8305 | * mode: c * c-basic-offset: 4 * fill-column: 78 * tab-width: 8 * indent-tabs-mode: nil * End: */ |
Added generic/tclTestABSList.c.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 | // Tcl Abstract List test command: "lstring" #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include <string.h> #include <limits.h> #include "tclInt.h" /* * Forward references */ Tcl_Obj *myNewLStringObj(Tcl_WideInt start, Tcl_WideInt length); static void freeRep(Tcl_Obj* alObj); static Tcl_Obj* my_LStringObjSetElem(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size numIndcies, Tcl_Obj *const indicies[], Tcl_Obj *valueObj); static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static Tcl_WideInt my_LStringObjLength(Tcl_Obj *lstringObjPtr); static int my_LStringObjIndex(Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size index, Tcl_Obj **charObjPtr); static int my_LStringObjRange(Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr); static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr); static int my_LStringReplace(Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert, Tcl_Obj *const insertObjs[]); static int my_LStringGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size *objcptr, Tcl_Obj ***objvptr); /* * Internal Representation of an lstring type value */ typedef struct LString { char *string; // NULL terminated utf-8 string Tcl_Size strlen; // num bytes in string Tcl_Size allocated; // num bytes allocated Tcl_Obj**elements; // elements array, allocated when GetElements is // called } LString; /* * AbstractList definition of an lstring type */ static Tcl_AbstractListType lstringTypes[12] = { { TCL_ABSTRACTLIST_VERSION_1, "lstring", /**/ NULL, /*default NULL,*/ DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, /**/ NULL, /*default DupLStringRep,*/ my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, /**/ NULL, /*default my_LStringObjLength,*/ my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, /**/ NULL, /*default my_LStringObjIndex,*/ my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, /**/ NULL, /*default my_LStringObjRange,*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ /**/ NULL, /*defaults my_LStringObjReverse,*/ my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, /**/ NULL, /*default NULL / *my_LStringGetElements,*/ freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, /**/ NULL, /*default freeRep,*/ NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, /**/ NULL, /*toString*/ my_LStringObjSetElem, /* use default update string */ my_LStringReplace }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, /**/ NULL, /*default my_LStringObjSetElem, / * use default update string */ NULL, /*default my_LStringReplace*/ }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ /**/ NULL, /*default my_LStringReplace*/ }, { TCL_ABSTRACTLIST_VERSION_1, "lstring", NULL, DupLStringRep, my_LStringObjLength, my_LStringObjIndex, my_LStringObjRange,/*ObjRange*/ my_LStringObjReverse, my_LStringGetElements, freeRep, NULL /*toString*/, my_LStringObjSetElem, /* use default update string */ my_LStringReplace } }; /* *---------------------------------------------------------------------- * * my_LStringObjIndex -- * * Implements the AbstractList Index function for the lstring type. The * Index function returns the value at the index position given. Caller * is resposible for freeing the Obj. * * Results: * TCL_OK on success. Returns a new Obj, with a 0 refcount in the * supplied charObjPtr location. Call has ownership of the Obj. * * Side effects: * Obj allocated. * *---------------------------------------------------------------------- */ static int my_LStringObjIndex( Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size index, Tcl_Obj **charObjPtr) { LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj); (void)interp; if (index < lstringRepPtr->strlen) { char cchar[2]; cchar[0] = lstringRepPtr->string[index]; cchar[1] = 0; *charObjPtr = Tcl_NewStringObj(cchar,1); } else { *charObjPtr = Tcl_NewObj(); } return TCL_OK; } /* *---------------------------------------------------------------------- * * my_LStringObjLength -- * * Implements the AbstractList Length function for the lstring type. * The Length function returns the number of elements in the list. * * Results: * WideInt number of elements in the list. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_WideInt my_LStringObjLength(Tcl_Obj *lstringObjPtr) { LString *lstringRepPtr = (LString *)Tcl_AbstractListGetConcreteRep(lstringObjPtr); return lstringRepPtr->strlen; } /* *---------------------------------------------------------------------- * * DupLStringRep -- * * Replicates the internal representation of the src value, and storing * it in the copy * * Results: * void * * Side effects: * Modifies the rep of the copyObj. * *---------------------------------------------------------------------- */ static void DupLStringRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { LString *srcLString = (LString*)Tcl_AbstractListGetConcreteRep(srcPtr); LString *copyLString = (LString*)Tcl_Alloc(sizeof(LString)); memcpy(copyLString, srcLString, sizeof(LString)); copyLString->string = (char*)Tcl_Alloc(srcLString->allocated); strcpy(copyLString->string, srcLString->string); copyLString->elements = NULL; Tcl_AbstractListSetConcreteRep(copyPtr,copyLString); return; } /* *---------------------------------------------------------------------- * * my_LStringObjSetElem -- * * Replace the element value at the given (nested) index with the * valueObj provided. If the lstring obj is shared, a new list is * created conntaining the modifed element. * * Results: * The modifed lstring is returned, either new or original. If the * index is invalid, NULL is returned, and an error is added to the * interp, if provided. * * Side effects: * A new obj may be created. * *---------------------------------------------------------------------- */ static Tcl_Obj* my_LStringObjSetElem( Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size numIndicies, Tcl_Obj *const indicies[], Tcl_Obj *valueObj) { LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj); Tcl_Size index; const char *newvalue; int status; Tcl_Obj *returnObj; if (numIndicies > 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Multiple indicies not supported by lstring.")); return NULL; } status = Tcl_GetIntForIndex(interp, indicies[0], lstringRepPtr->strlen, &index); if (status != TCL_OK) { return NULL; } returnObj = Tcl_IsShared(lstringObj) ? Tcl_DuplicateObj(lstringObj) : lstringObj; lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(returnObj); if (index >= lstringRepPtr->strlen) { index = lstringRepPtr->strlen; lstringRepPtr->strlen++; lstringRepPtr->string = (char*)Tcl_Realloc(lstringRepPtr->string, lstringRepPtr->strlen+1); } newvalue = Tcl_GetString(valueObj); lstringRepPtr->string[index] = newvalue[0]; Tcl_InvalidateStringRep(returnObj); return returnObj; } /* *---------------------------------------------------------------------- * * my_LStringObjRange -- * * Creates a new Obj with a slice of the src listPtr. * * Results: * A new Obj is assigned to newObjPtr. Returns TCL_OK * * Side effects: * A new Obj is created. * *---------------------------------------------------------------------- */ static int my_LStringObjRange( Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr) { Tcl_Obj *rangeObj; LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj); LString *rangeRep; Tcl_WideInt len = toIdx - fromIdx + 1; if (lstringRepPtr->strlen < fromIdx || lstringRepPtr->strlen < toIdx) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Range out of bounds ")); return TCL_ERROR; } if (len <= 0) { // Return empty value; *newObjPtr = Tcl_NewObj(); } else { rangeRep = (LString*)Tcl_Alloc(sizeof(LString)); rangeRep->allocated = len+1; rangeRep->strlen = len; rangeRep->string = (char*)Tcl_Alloc(rangeRep->allocated); strncpy(rangeRep->string,&lstringRepPtr->string[fromIdx],len); rangeRep->string[len] = 0; rangeRep->elements = NULL; rangeObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(lstringObj)); Tcl_AbstractListSetConcreteRep(rangeObj, rangeRep); *newObjPtr = rangeObj; } return TCL_OK; } /* *---------------------------------------------------------------------- * * my_LStringObjReverse -- * * Creates a new Obj with the the order of the elements in the lstring * value reversed, where first is last and last is first, etc. * * Results: * A new Obj is assigned to newObjPtr. Returns TCL_OK * * Side effects: * A new Obj is created. * *---------------------------------------------------------------------- */ static int my_LStringObjReverse(Tcl_Interp *interp, Tcl_Obj *srcObj, Tcl_Obj **newObjPtr) { LString *srcRep = (LString*)Tcl_AbstractListGetConcreteRep(srcObj); Tcl_Obj *revObj; LString *revRep = (LString*)Tcl_Alloc(sizeof(LString)); Tcl_WideInt len; char *srcp, *dstp, *endp; len = srcRep->strlen; revRep->strlen = len; revRep->allocated = len+1; revRep->string = (char*)Tcl_Alloc(revRep->allocated); revRep->elements = NULL; srcp = srcRep->string; endp = &srcRep->string[len]; dstp = &revRep->string[len]; *dstp-- = 0; while (srcp < endp) { *dstp-- = *srcp++; } revObj = Tcl_AbstractListObjNew(interp, Tcl_AbstractListGetType(srcObj)); Tcl_AbstractListSetConcreteRep(revObj, revRep); *newObjPtr = revObj; return TCL_OK; } /* *---------------------------------------------------------------------- * * my_LStringReplace -- * * Delete and/or Insert elements in the list, starting at index first. * See more details in the comments below. This should not be called with * a Shared Obj. * * Results: * The value of the listObj is modified. * * Side effects: * The string rep is invalidated. * *---------------------------------------------------------------------- */ static int my_LStringReplace( Tcl_Interp *interp, Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, Tcl_Size numToInsert, Tcl_Obj *const insertObjs[]) { LString *lstringRep = (LString*)Tcl_AbstractListGetConcreteRep(listObj); Tcl_Size newLen; Tcl_Size x, ix, kx; char *newStr; char *oldStr = lstringRep->string; (void)interp; newLen = lstringRep->strlen - numToDelete + numToInsert; if (newLen >= lstringRep->allocated) { lstringRep->allocated = newLen+1; newStr = (char*)Tcl_Alloc(lstringRep->allocated); newStr[newLen] = 0; } else { newStr = oldStr; } /* Tcl_ListObjReplace replaces zero or more elements of the list * referenced by listPtr with the objc values in the array referenced by * objv. * * If listPtr does not point to a list value, Tcl_ListObjReplace * will attempt to convert it to one; if the conversion fails, it returns * TCL_ERROR and leaves an error message in the interpreter's result value * if interp is not NULL. Otherwise, it returns TCL_OK after replacing the * values. * * * If objv is NULL, no new elements are added. * * * If the argument first is zero or negative, it refers to the first * element. * * * If first is greater than or equal to the number of elements in the * list, then no elements are deleted; the new elements are appended * to the list. count gives the number of elements to replace. * * * If count is zero or negative then no elements are deleted; the new * elements are simply inserted before the one designated by first. * Tcl_ListObjReplace invalidates listPtr's old string representation. * * * The reference counts of any elements inserted from objv are * incremented since the resulting list now refers to them. Similarly, * the reference counts for any replaced values are decremented. */ // copy 0 to first-1 if (newStr != oldStr) { strncpy(newStr, oldStr, first); } // move front elements to keep for(x=0, kx=0; x<newLen && kx<first; kx++, x++) { newStr[x] = oldStr[kx]; } // Insert new elements into new string for(x=first, ix=0; ix<numToInsert; x++, ix++) { char const *svalue = Tcl_GetString(insertObjs[ix]); newStr[x] = svalue[0]; } // Move remaining elements if ((first+numToDelete) < newLen) { for(/*x,*/ kx=first+numToDelete; (kx <lstringRep->strlen && x<newLen); x++, kx++) { newStr[x] = oldStr[kx]; } } // Terminate new string. newStr[newLen] = 0; if (oldStr != newStr) { Tcl_Free(oldStr); } lstringRep->string = newStr; lstringRep->strlen = newLen; /* Changes made to value, string rep no longer valid */ Tcl_InvalidateStringRep(listObj); return TCL_OK; } static Tcl_AbstractListType * my_SetAbstractProc(Tcl_AbstractListProcType ptype) { Tcl_AbstractListType *typePtr = &lstringTypes[11]; if (TCL_ABSL_NEW <= ptype && ptype <= TCL_ABSL_REPLACE) { typePtr = &lstringTypes[ptype]; } return typePtr; } /* *---------------------------------------------------------------------- * * my_NewLStringObj -- * * Creates a new lstring Obj using the string value of objv[0] * * Results: * results * * Side effects: * side effects * *---------------------------------------------------------------------- */ static Tcl_Obj * my_NewLStringObj( Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]) { LString *lstringRepPtr; size_t repSize; Tcl_Obj *lstringPtr; const char *string; static const char* procTypeNames[] = { "NEW", "DUPREP", "LENGTH", "INDEX", "SLICE", "REVERSE", "GETELEMENTS", "FREEREP", "TOSTRING", "SETELEMENT", "REPLACE", NULL }; int i = 0; Tcl_AbstractListProcType ptype; Tcl_AbstractListType *lstringTypePtr = &lstringTypes[11]; repSize = sizeof(LString); lstringRepPtr = (LString*)Tcl_Alloc(repSize); while (i<objc) { const char *s = Tcl_GetString(objv[i]); if (strcmp(s, "-not")==0) { i++; if (Tcl_GetIndexFromObj(interp, objv[i], procTypeNames, "proctype", 0, &ptype)==TCL_OK) { lstringTypePtr = my_SetAbstractProc(ptype); } } else if (strcmp(s, "--") == 0) { // End of options i++; break; } else { break; } i++; } if (i != objc-1) { Tcl_WrongNumArgs(interp, 0, objv, "lstring string"); return NULL; } string = Tcl_GetString(objv[i]); lstringPtr = Tcl_AbstractListObjNew(interp, lstringTypePtr); lstringRepPtr->strlen = strlen(string); lstringRepPtr->allocated = lstringRepPtr->strlen + 1; lstringRepPtr->string = (char*)Tcl_Alloc(lstringRepPtr->allocated); strcpy(lstringRepPtr->string, string); lstringRepPtr->elements = NULL; Tcl_AbstractListSetConcreteRep(lstringPtr, lstringRepPtr); if (lstringRepPtr->strlen > 0) { Tcl_InvalidateStringRep(lstringPtr); } else { Tcl_InitStringRep(lstringPtr, NULL, 0); } return lstringPtr; } /* *---------------------------------------------------------------------- * * freeRep -- * * Free the value storage of the lstring Obj. * * Results: * void * * Side effects: * Memory free'd. * *---------------------------------------------------------------------- */ static void freeRep(Tcl_Obj* lstringObj) { LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj); if (lstringRepPtr->string) { Tcl_Free(lstringRepPtr->string); } if (lstringRepPtr->elements) { Tcl_Obj **objptr = lstringRepPtr->elements; while (objptr < &lstringRepPtr->elements[lstringRepPtr->strlen]) { Tcl_DecrRefCount(*objptr++); } Tcl_Free((char*)lstringRepPtr->elements); lstringRepPtr->elements = NULL; } Tcl_Free((char*)lstringRepPtr); Tcl_AbstractListSetConcreteRep(lstringObj, NULL); } /* *---------------------------------------------------------------------- * * my_LStringGetElements -- * * Get the elements of the list in an array. * * Results: * objc, objv return values * * Side effects: * A Tcl_Obj is stored for every element of the abstract list * *---------------------------------------------------------------------- */ static int my_LStringGetElements(Tcl_Interp *interp, Tcl_Obj *lstringObj, Tcl_Size *objcptr, Tcl_Obj ***objvptr) { LString *lstringRepPtr = (LString*)Tcl_AbstractListGetConcreteRep(lstringObj); Tcl_Obj **objPtr; char *cptr = lstringRepPtr->string; (void)interp; if (lstringRepPtr->strlen == 0) { *objcptr = 0; *objvptr = NULL; return TCL_OK; } if (lstringRepPtr->elements == NULL) { lstringRepPtr->elements = (Tcl_Obj**)Tcl_Alloc(sizeof(Tcl_Obj*) * lstringRepPtr->strlen); objPtr=lstringRepPtr->elements; while (objPtr<&lstringRepPtr->elements[lstringRepPtr->strlen]) { *objPtr = Tcl_NewStringObj(cptr++,1); Tcl_IncrRefCount(*objPtr++); } } *objvptr = lstringRepPtr->elements; *objcptr = lstringRepPtr->strlen; return TCL_OK; } /* *---------------------------------------------------------------------- * * lLStringObjCmd -- * * Script level command that creats an lstring Obj value. * * Results: * Returns and lstring Obj value in the interp results. * * Side effects: * Interp results modified. * *---------------------------------------------------------------------- */ static int lLStringObjCmd( void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj * const objv[]) { Tcl_Obj *lstringObj; (void)clientData; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "string"); return TCL_ERROR; } lstringObj = my_NewLStringObj(interp, objc-1, &objv[1]); if (lstringObj) { Tcl_SetObjResult(interp, lstringObj); return TCL_OK; } return TCL_ERROR; } /* *---------------------------------------------------------------------- * * Lstring_Init -- * * DL load init function. Defines the "lstring" command. * * Results: * "lstring" command added to the interp. * * Side effects: * A new command is defined. * *---------------------------------------------------------------------- */ int Tcl_ABSListTest_Init(Tcl_Interp *interp) { if (Tcl_InitStubs(interp, "8.7", 0) == NULL) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "lstring", lLStringObjCmd, NULL, NULL); Tcl_PkgProvide(interp, "abstractlisttest", "1.0.0"); return TCL_OK; } |
Added tests/abstractlist.test.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 | # Exercise AbstractList API via the "lstring" command defined in tclTestABSList.c # # Copyright © 2022 Brian Griffin # # 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 testevalex [llength [info commands testevalex]] set abstractlisttestvars [info var *] proc value-isa {var {expected ""}} { upvar $var v set t [lindex [tcl::unsupported::representation $v] 3] if {$expected ne "" && $expected ne $t} { set fail " expecting: $expected" } else { set fail "" } return "$var is a $t$fail" } proc value-cmp {vara varb} { upvar $vara a upvar $varb b set ta [tcl::unsupported::representation $a] set tb [tcl::unsupported::representation $b] return [string compare $ta $tb] } set str "My name is Inigo Montoya. You killed my father. Prepare to die!" set str2 "Vizzini: HE DIDN'T FALL? INCONCEIVABLE. Inigo Montoya: You keep using that word. I do not think it means what you think it means." test abstractlist-1.0 {error cases} -body { lstring } \ -returnCodes 1 \ -result {wrong # args: should be "lstring string"} test abstractlist-1.1 {error cases} -body { lstring a b c } -returnCodes 1 \ -result {wrong # args: should be "lstring string"} test abstractlist-2.0 {no shimmer llength} { set l [lstring $str] set l-isa [value-isa l] set len [llength $l] set l-isa2 [value-isa l] list $l ${l-isa} ${len} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}} test abstractlist-2.1 {no shimmer lindex} { set l [lstring $str] set l-isa [value-isa l] set ele [lindex $l 22] set l-isa2 [value-isa l] list $l ${l-isa} ${ele} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}} test abstractlist-2.2 {no shimmer lreverse} { set l [lstring $str] set l-isa [value-isa l] set r [lreverse $l] set r-isa [value-isa r] set l-isa2 [value-isa l] list $r ${l-isa} ${r-isa} ${l-isa2} } {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}} test abstractlist-2.3 {no shimmer lrange} { set l [lstring $str] set l-isa [value-isa l] set il [lsearch -all [lstring $str] { }] set l-isa2 [value-isa l] lappend il [llength $l] set start 0 set words [lmap i $il { set w [join [lrange $l $start $i-1] {} ] set start [expr {$i+1}] set w }] set l-isa3 [value-isa l] list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}} test abstractlist-2.4 {no shimmer foreach} { set l [lstring $str] set l-isa [value-isa l] set word {} set words {} foreach c $l { if {$c eq { }} { lappend words $word set word {} } else { append word $c } } if {$word ne ""} { lappend words $word } set l-isa2 [value-isa l] list ${l-isa} ${l-isa2} $words } {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}} # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring. # test abstractlist-2.5 {!no shimmer lreplace} { set l [lstring $str2] set l-isa [value-isa l] set m [lreplace $l 18 23 { } f a i l ?] set m-isa [value-isa m] set l-isa1 [value-isa l] list ${l-isa} $m ${m-isa} ${l-isa1} } {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a lstring} {l is a lstring}} test abstractlist-2.6 {no shimmer ledit} { # "ledit m 9 8 S" set l [lstring $str2] set l-isa [value-isa l] set e [ledit l 9 8 S] set e-isa [value-isa e] list ${l-isa} $e ${e-isa} } {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}} test abstractlist-2.7 {no shimmer linsert} { # "ledit m 9 8 S" set l [lstring $str2] set l-isa [value-isa l] set i [linsert $l 12 {*}[split "almost " {}]] set i-isa [value-isa i] set res [list ${l-isa} $i ${i-isa}] set p [lpop i 23] set p-isa [value-isa p] set i-isa2 [value-isa i] lappend res $p ${p-isa} $i ${i-isa2} } {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}} test abstractlist-2.8 {shimmer lassign} { set l [lstring Inconceivable] set l-isa [value-isa l] set l2 [lassign $l i n c] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}} test abstractlist-2.9 {no shimmer lremove} { set l [lstring Inconceivable] set l-isa [value-isa l] set l2 [lremove $l 0 1] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}} test abstractlist-2.10 {shimmer lreverse} { set l [lstring Inconceivable] set l-isa [value-isa l] set l2 [lreverse $l] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}} test abstractlist-2.11 {shimmer lset} { set l [lstring Inconceivable] set l-isa [value-isa l] set m [lset l 2 k] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0} # lrepeat test abstractlist-2.12 {shimmer lrepeat} { set l [lstring Inconceivable] set l-isa [value-isa l] set m [lrepeat 3 $l] set m-isa [value-isa m] set n [lindex $m 1] list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n] } {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0} test abstractlist-2.13 {no shimmer join llength==1} { set l [lstring G] set l-isa [value-isa l] set j [join $l :] set j-isa [value-isa j] list ${l-isa} $l ${j-isa} $j } {{l is a lstring} G {j is a pure} G} test abstractlist-2.14 {error case lset multiple indicies} -body { set l [lstring Inconceivable] set l-isa [value-isa l] set m [lset l 2 0 1 k] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } -returnCodes 1 \ -result {Multiple indicies not supported by lstring.} # lsort test abstractlist-3.0 {no shimmer llength} { set l [lstring -not SLICE $str] set l-isa [value-isa l] set len [llength $l] set l-isa2 [value-isa l] list $l ${l-isa} ${len} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}} test abstractlist-3.1 {no shimmer lindex} { set l [lstring -not SLICE $str] set l-isa [value-isa l] set n 22 set ele [lindex $l $n] ;# exercise INST_LIST_INDEX set l-isa2 [value-isa l] list $l ${l-isa} ${ele} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}} test abstractlist-3.2 {no shimmer lreverse} { set l [lstring -not SLICE $str] set l-isa [value-isa l] set r [lreverse $l] set r-isa [value-isa r] set l-isa2 [value-isa l] list $r ${l-isa} ${r-isa} ${l-isa2} } {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}} test abstractlist-3.3 {shimmer lrange} { set l [lstring -not SLICE $str] set l-isa [value-isa l] set il [lsearch -all [lstring -not SLICE $str] { }] set l-isa2 [value-isa l] lappend il [llength $l] set start 0 set words [lmap i $il { set w [join [lrange $l $start $i-1] {} ] set start [expr {$i+1}] set w }] set l-isa3 [value-isa l]; # lrange defaults to list behavior list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a list} {My name is Inigo Montoya. You killed my father. Prepare to die!}} test abstractlist-3.4 {no shimmer foreach} { set l [lstring -not SLICE $str] set l-isa [value-isa l] set word {} set words {} foreach c $l { if {$c eq { }} { lappend words $word set word {} } else { append word $c } } if {$word ne ""} { lappend words $word } set l-isa2 [value-isa l] list ${l-isa} ${l-isa2} $words } {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}} # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring. # test abstractlist-3.5 {!no shimmer lreplace} { set l [lstring -not SLICE $str2] set l-isa [value-isa l] set m [lreplace $l 18 23 { } f a i l ?] set m-isa [value-isa m] set l-isa1 [value-isa l] list ${l-isa} $m ${m-isa} ${l-isa1} } {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a lstring} {l is a lstring}} test abstractlist-3.6 {no shimmer ledit} { # "ledit m 9 8 S" set l [lstring -not SLICE $str2] set l-isa [value-isa l] set e [ledit l 9 8 S] set e-isa [value-isa e] list ${l-isa} $e ${e-isa} } {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}} test abstractlist-3.7 {no shimmer linsert} { # "ledit m 9 8 S" set res {} set l [lstring -not SLICE $str2] set l-isa [value-isa l] set i [linsert $l 12 {*}[split "almost " {}]] set i-isa [value-isa i] set res [list ${l-isa} $i ${i-isa}] set p [lpop i 23] set p-isa [value-isa p] set i-isa2 [value-isa i] lappend res $p ${p-isa} $i ${i-isa2} } {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring}} test abstractlist-3.8 {shimmer lassign} { set l [lstring -not SLICE Inconceivable] set l-isa [value-isa l] set l2 [lassign $l i n c] ;# must be using lrange internally set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a list} {l2 is a list}} test abstractlist-3.9 {no shimmer lremove} { set l [lstring -not SLICE Inconceivable] set l-isa [value-isa l] set l2 [lremove $l 0 1] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}} test abstractlist-3.10 {shimmer lreverse} { set l [lstring -not SLICE Inconceivable] set l-isa [value-isa l] set l2 [lreverse $l] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}} test abstractlist-3.11 {shimmer lset} { set l [lstring -not SLICE Inconceivable] set l-isa [value-isa l] set m [lset l 2 k] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0} # lrepeat test abstractlist-3.12 {shimmer lrepeat} { set l [lstring -not SLICE Inconceivable] set l-isa [value-isa l] set m [lrepeat 3 $l] set m-isa [value-isa m] set n [lindex $m 1] list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n] } {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0} # lsort foreach not {{} REVERSE SLICE SETELEMENT REPLACE GETELEMENTS} { testConstraint [format "%sShimmer" [string totitle $not]] [expr {$not eq ""}] set options [expr {$not ne "" ? "-not $not" : ""}] test abstractlist-$not-4.0 {no shimmer llength} { set l [lstring {*}$options $str] set l-isa [value-isa l] set len [llength $l] set l-isa2 [value-isa l] list $l ${l-isa} ${len} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} 63 {l is a lstring}} test abstractlist-$not-4.1 {no shimmer lindex} { set l [lstring {*}$options $str] set l-isa [value-isa l] set ele [lindex $l 22] set l-isa2 [value-isa l] list $l ${l-isa} ${ele} ${l-isa2} } {{M y { } n a m e { } i s { } I n i g o { } M o n t o y a . { } Y o u { } k i l l e d { } m y { } f a t h e r . { } P r e p a r e { } t o { } d i e !} {l is a lstring} y {l is a lstring}} test abstractlist-$not-4.2 {lreverse} ReverseShimmer { set l [lstring {*}$options $str] set l-isa [value-isa l] set r [lreverse $l] set r-isa [value-isa r] set l-isa2 [value-isa l] list $r ${l-isa} ${r-isa} ${l-isa2} } {{! e i d { } o t { } e r a p e r P { } . r e h t a f { } y m { } d e l l i k { } u o Y { } . a y o t n o M { } o g i n I { } s i { } e m a n { } y M} {l is a lstring} {r is a lstring} {l is a lstring}} test abstractlist-$not-4.3 {no shimmer lrange} RangeShimmer { set l [lstring {*}$options $str] set l-isa [value-isa l] set il [lsearch -all [lstring {*}$options $str] { }] set l-isa2 [value-isa l] lappend il [llength $l] set start 0 set words [lmap i $il { set w [join [lrange $l $start $i-1] {} ] set start [expr {$i+1}] set w }] set l-isa3 [value-isa l] list ${l-isa} $il ${l-isa2} ${l-isa3} $words } {{l is a lstring} {2 7 10 16 25 29 36 39 47 55 58 63} {l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}} test abstractlist-$not-4.4 {no shimmer foreach} { set l [lstring {*}$options $str] set l-isa [value-isa l] set word {} set words {} foreach c $l { if {$c eq { }} { lappend words $word set word {} } else { append word $c } } if {$word ne ""} { lappend words $word } set l-isa2 [value-isa l] list ${l-isa} ${l-isa2} $words } {{l is a lstring} {l is a lstring} {My name is Inigo Montoya. You killed my father. Prepare to die!}} # # The TBCE implements lreplace as a lrange + lappend operation, so, in this case, $m results is a list, not an lstring. # test abstractlist-$not-4.5 {!no shimmer lreplace} RangeShimmer { set l [lstring {*}$options $str2] set l-isa [value-isa l] set m [lreplace $l 18 23 { } f a i l ?] set m-isa [value-isa m] set l-isa1 [value-isa l] list ${l-isa} $m ${m-isa} ${l-isa1} } {{l is a lstring} {V i z z i n i : { } H E { } D I D N ' T { } f a i l ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {m is a list} {l is a lstring}} test abstractlist-$not-4.6 {no shimmer ledit} {SetelementShimmer ReplaceShimmer} { # "ledit m 9 8 S" set l [lstring {*}$options $str2] set l-isa [value-isa l] set e [ledit l 9 8 S] set e-isa [value-isa e] list ${l-isa} $e ${e-isa} } {{l is a lstring} {V i z z i n i : { } S H E { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {e is a lstring}} test abstractlist-$not-4.7 {no shimmer linsert} ReplaceShimmer { # "ledit m 9 8 S" set l [lstring {*}$options $str2] set l-isa [value-isa l] set i [linsert $l 12 {*}[split "almost " {}]] set i-isa [value-isa i] set res [list ${l-isa} $i ${i-isa}] set p [lpop i 23] set p-isa [value-isa p] set i-isa2 [value-isa i] lappend res $p ${p-isa} $i ${i-isa2} } {{l is a lstring} {V i z z i n i : { } H E { } a l m o s t { } D I D N ' T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a lstring} ' {p is a pure} {V i z z i n i : { } H E { } a l m o s t { } D I D N T { } F A L L ? { } I N C O N C E I V A B L E . { } I n i g o { } M o n t o y a : { } Y o u { } k e e p { } u s i n g { } t h a t { } w o r d . { } I { } d o { } n o t { } t h i n k { } i t { } m e a n s { } w h a t { } y o u { } t h i n k { } i t { } m e a n s .} {i is a list}} # lassign probably uses lrange internally test abstractlist-$not-4.8 {shimmer lassign} RangeShimmer { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set l2 [lassign $l i n c] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {o n c e i v a b l e} {l is a lstring} {l2 is a lstring}} test abstractlist-$not-4.9 {no shimmer lremove} ReplaceShimmer { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set l2 [lremove $l 0 1] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {c o n c e i v a b l e} {l is a lstring} {l2 is a lstring}} test abstractlist-$not-4.10 {shimmer lreverse} ReverseShimmer { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set l2 [lreverse $l] set l-isa2 [value-isa l] set l2-isa [value-isa l2] list $l ${l-isa} $l2 ${l-isa2} ${l2-isa} } {{I n c o n c e i v a b l e} {l is a lstring} {e l b a v i e c n o c n I} {l is a lstring} {l2 is a lstring}} test abstractlist-$not-4.11 {shimmer lset} SetelementShimmer { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set m [lset l 2 k] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0} test abstractlist-$not-4.11x {lset not compiled} {SetelementShimmer testevalex} { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set m [testevalex {lset l 2 k}] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } {{I n k o n c e i v a b l e} {l is a lstring} {I n k o n c e i v a b l e} {m is a lstring} 0} test abstractlist-$not-4.11e {error case lset multiple indicies} \ -constraints {SetelementShimmer testevalex} -body { set l [lstring Inconceivable] set l-isa [value-isa l] set m [testevalex {lset l 2 0 1 k}] set m-isa [value-isa m] list $l ${l-isa} $m ${m-isa} [value-cmp l m] } -returnCodes 1 \ -result {Multiple indicies not supported by lstring.} # lrepeat test abstractlist-$not-4.12 {shimmer lrepeat} { set l [lstring {*}$options Inconceivable] set l-isa [value-isa l] set m [lrepeat 3 $l] set m-isa [value-isa m] set n [lindex $m 1] list $l ${l-isa} $m ${m-isa} [value-isa n] [value-cmp l n] } {{I n c o n c e i v a b l e} {l is a lstring} {{I n c o n c e i v a b l e} {I n c o n c e i v a b l e} {I n c o n c e i v a b l e}} {m is a list} {n is a lstring} 0} # Disable constraint testConstraint [format "%sShimmer" [string totitle $not]] 1 } # lsort # cleanup ::tcltest::cleanupTests proc my_abstl_cleanup {vars} { set nowvars [uplevel info vars] foreach var $nowvars { if {$var ni $vars} { uplevel unset $var lappend clean-list $var } } return ${clean-list} } my_abstl_cleanup $abstractlisttestvars |
Changes to tests/lseq.test.
︙ | ︙ | |||
533 534 535 536 537 538 539 | lrange [lseq 1 5] fred ginger } -returnCodes 1 \ -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?} test lseq-4.9 {error case lrange} -body { set fred 7 set ginger 8 | | > | > > > > > > | | 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 | lrange [lseq 1 5] fred ginger } -returnCodes 1 \ -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?} test lseq-4.9 {error case lrange} -body { set fred 7 set ginger 8 lrange [lseq 1 10] $fred $ginger } -result {8 9} test lseq-4.10 {lset shimmer} -body { set l [lseq 15] lappend res $l [lindex [tcl::unsupported::representation $l] 3] lset l 3 25 lappend res $l [lindex [tcl::unsupported::representation $l] 3] } -result {{0 1 2 3 4 5 6 7 8 9 10 11 12 13 14} arithseries {0 1 2 25 4 5 6 7 8 9 10 11 12 13 14} list} # Panic when using variable value? test lseq-4.10 {panic using variable index} { set i 0 lindex [lseq 10] $i } {0} |
︙ | ︙ |
Changes to unix/Makefile.in.
︙ | ︙ | |||
289 290 291 292 293 294 295 | DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ ${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ | | | > | > | | 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \ ${AC_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@ TCLSH_OBJS = tclAppInit.o TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclTestABSList.o XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \ tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o \ tclTestABSList.o GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o \ tclAbstractList.o tclArithSeries.o tclAlloc.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 \ tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \ tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \ tclIORChan.o tclIORTrans.o tclIOGT.o tclIOSock.o tclIOUtil.o \ |
︙ | ︙ | |||
378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 | $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls \ $(GENERIC_DIR)/tclOO.decls \ $(GENERIC_DIR)/tclTomMath.decls GENERIC_HDRS = \ $(GENERIC_DIR)/tcl.h \ $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclOOInt.h \ $(GENERIC_DIR)/tclOOIntDecls.h \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ | > > < | | > | 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 | $(GENERIC_DIR)/tcl.decls \ $(GENERIC_DIR)/tclInt.decls \ $(GENERIC_DIR)/tclOO.decls \ $(GENERIC_DIR)/tclTomMath.decls GENERIC_HDRS = \ $(GENERIC_DIR)/tcl.h \ $(GENERIC_DIR)/tclAbstractList.h \ $(GENERIC_DIR)/tclArithSeries.h \ $(GENERIC_DIR)/tclDecls.h \ $(GENERIC_DIR)/tclInt.h \ $(GENERIC_DIR)/tclIntDecls.h \ $(GENERIC_DIR)/tclIntPlatDecls.h \ $(GENERIC_DIR)/tclTomMath.h \ $(GENERIC_DIR)/tclTomMathDecls.h \ $(GENERIC_DIR)/tclOO.h \ $(GENERIC_DIR)/tclOODecls.h \ $(GENERIC_DIR)/tclOOInt.h \ $(GENERIC_DIR)/tclOOIntDecls.h \ $(GENERIC_DIR)/tclPatch.h \ $(GENERIC_DIR)/tclPlatDecls.h \ $(GENERIC_DIR)/tclPort.h \ $(GENERIC_DIR)/tclRegexp.h GENERIC_SRCS = \ $(GENERIC_DIR)/regcomp.c \ $(GENERIC_DIR)/regexec.c \ $(GENERIC_DIR)/regfree.c \ $(GENERIC_DIR)/regerror.c \ $(GENERIC_DIR)/tclAbstractList.c \ $(GENERIC_DIR)/tclArithSeries.c \ $(GENERIC_DIR)/tclAlloc.c \ $(GENERIC_DIR)/tclAssembly.c \ $(GENERIC_DIR)/tclAsync.c \ $(GENERIC_DIR)/tclBasic.c \ $(GENERIC_DIR)/tclBinary.c \ $(GENERIC_DIR)/tclCkalloc.c \ $(GENERIC_DIR)/tclClock.c \ $(GENERIC_DIR)/tclCmdAH.c \ |
︙ | ︙ | |||
464 465 466 467 468 469 470 471 472 473 474 475 476 477 | $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ $(GENERIC_DIR)/tclThreadStorage.c \ $(GENERIC_DIR)/tclTimer.c \ | > | 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 | $(GENERIC_DIR)/tclResolve.c \ $(GENERIC_DIR)/tclResult.c \ $(GENERIC_DIR)/tclScan.c \ $(GENERIC_DIR)/tclStubInit.c \ $(GENERIC_DIR)/tclStringObj.c \ $(GENERIC_DIR)/tclStrToD.c \ $(GENERIC_DIR)/tclTest.c \ $(GENERIC_DIR)/tclTestABSList.c \ $(GENERIC_DIR)/tclTestObj.c \ $(GENERIC_DIR)/tclTestProcBodyObj.c \ $(GENERIC_DIR)/tclThread.c \ $(GENERIC_DIR)/tclThreadAlloc.c \ $(GENERIC_DIR)/tclThreadJoin.c \ $(GENERIC_DIR)/tclThreadStorage.c \ $(GENERIC_DIR)/tclTimer.c \ |
︙ | ︙ | |||
1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 | regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c | > > > > > > < < < | 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 | regfree.o: $(REGHDRS) $(GENERIC_DIR)/regfree.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regfree.c regerror.o: $(REGHDRS) $(GENERIC_DIR)/regerrs.h $(GENERIC_DIR)/regerror.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regerror.c tclAbstractList.o: $(GENERIC_DIR)/tclAbstractList.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAbstractList.c tclArithSeries.o: $(GENERIC_DIR)/tclArithSeries.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclArithSeries.c tclAppInit.o: $(UNIX_DIR)/tclAppInit.c $(CC) -c $(APP_CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c tclAlloc.o: $(GENERIC_DIR)/tclAlloc.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAlloc.c tclAssembly.o: $(GENERIC_DIR)/tclAssembly.c $(COMPILEHDR) $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAssembly.c tclAsync.o: $(GENERIC_DIR)/tclAsync.c $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclAsync.c tclBasic.o: $(GENERIC_DIR)/tclBasic.c $(COMPILEHDR) $(MATHHDRS) $(NREHDR) |
︙ | ︙ | |||
1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 | -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \ $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c | > > > | 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 | -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip \ $(GENERIC_DIR)/tclZipfs.c tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c tclTestABSList.o: $(GENERIC_DIR)/tclTestABSList.c $(MATHHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestABSList.c tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS) $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c $(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c |
︙ | ︙ |
Changes to win/Makefile.in.
︙ | ︙ | |||
268 269 270 271 272 273 274 | ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ | | > | > | 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 | ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ tclTestObj.$(OBJEXT) \ tclTestProcBodyObj.$(OBJEXT) \ tclThreadTest.$(OBJEXT) \ tclWinTest.$(OBJEXT) \ tclTestABSList.$(OBJEXT) GENERIC_OBJS = \ regcomp.$(OBJEXT) \ regexec.$(OBJEXT) \ regfree.$(OBJEXT) \ regerror.$(OBJEXT) \ tclAbstractList.$(OBJEXT) \ tclArithSeries.$(OBJEXT) \ tclAlloc.$(OBJEXT) \ tclAssembly.$(OBJEXT) \ tclAsync.$(OBJEXT) \ tclBasic.$(OBJEXT) \ tclBinary.$(OBJEXT) \ tclCkalloc.$(OBJEXT) \ tclClock.$(OBJEXT) \ tclCmdAH.$(OBJEXT) \ |
︙ | ︙ |
Changes to win/makefile.vc.
︙ | ︙ | |||
221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 | TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.obj \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ !if !$(STATIC_BUILD) $(OUT_DIR)\tommath.lib \ !endif $(TMP_DIR)\testMain.obj COREOBJS = \ $(TMP_DIR)\regcomp.obj \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\regexec.obj \ $(TMP_DIR)\regfree.obj \ | > | > | 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 | TCLTESTOBJS = \ $(TMP_DIR)\tclTest.obj \ $(TMP_DIR)\tclTestObj.obj \ $(TMP_DIR)\tclTestProcBodyObj.obj \ $(TMP_DIR)\tclThreadTest.obj \ $(TMP_DIR)\tclWinTest.obj \ $(TMP_DIR)\tclTestABSList.obj \ !if !$(STATIC_BUILD) $(OUT_DIR)\tommath.lib \ !endif $(TMP_DIR)\testMain.obj COREOBJS = \ $(TMP_DIR)\regcomp.obj \ $(TMP_DIR)\regerror.obj \ $(TMP_DIR)\regexec.obj \ $(TMP_DIR)\regfree.obj \ $(TMP_DIR)\tclAbstractList.obj \ $(TMP_DIR)\tclArithSeries.obj \ $(TMP_DIR)\tclAlloc.obj \ $(TMP_DIR)\tclAssembly.obj \ $(TMP_DIR)\tclAsync.obj \ $(TMP_DIR)\tclBasic.obj \ $(TMP_DIR)\tclBinary.obj \ $(TMP_DIR)\tclCkalloc.obj \ $(TMP_DIR)\tclClock.obj \ $(TMP_DIR)\tclCmdAH.obj \ |
︙ | ︙ | |||
822 823 824 825 826 827 828 829 830 831 832 833 834 835 | $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h $(cc32) $(appcflags) -I$(TMP_DIR) \ -Fo$@ $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c $(cc32) $(pkgcflags) \ -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \ | > > > | 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 | $(TMP_DIR)\tclTest.obj: $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclUuid.h $(cc32) $(appcflags) -I$(TMP_DIR) \ -Fo$@ $(GENERICDIR)\tclTest.c $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclTestABSList.obj: $(GENERICDIR)\tclTestABSList.c $(cc32) $(appcflags) -Fo$@ $? $(TMP_DIR)\tclWinTest.obj: $(WIN_DIR)\tclWinTest.c $(CCAPPCMD) $? $(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c $(cc32) $(pkgcflags) \ -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip \ |
︙ | ︙ |