Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | merge trunk |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-9-0-b2-rc |
Files: | files | file ages | folders |
SHA3-256: |
19b9504de21ce0adbbdf311bb2017252 |
User & Date: | dgp 2024-04-24 18:30:27 |
2024-04-24
| ||
18:39 | dup test name check-in: 9c1c2e40ef user: dgp tags: core-9-0-b2-rc | |
18:30 | merge trunk check-in: 19b9504de2 user: dgp tags: core-9-0-b2-rc | |
17:19 | Merge revisions to the hash table implementation that prevent observed reads from uninitialized memo... check-in: 9ec15a7a14 user: dgp tags: core-9-0-b2-rc | |
2024-04-22
| ||
18:37 | Only use Tcl_TomMath_InitStubs() when TCL_WITH_EXTERNAL_TOMMATH is not defined check-in: 16b8cb3ac5 user: jan.nijtmans tags: trunk, main | |
Changes to .fossil-settings/ignore-glob.
︙ | ︙ | |||
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 | unix/dltest/*.o unix/dltest/*.sl unix/dltest/*.so unix/tcl.pc unix/tclIndex unix/Tcl-Info.plist unix/Tclsh-Info.plist unix/pkgs/* win/Debug* win/Release* win/*.manifest win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmakehlp.out win/nmhlp-out.txt | > > | 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 | unix/dltest/*.o unix/dltest/*.sl unix/dltest/*.so unix/tcl.pc unix/tclIndex unix/Tcl-Info.plist unix/Tclsh-Info.plist unix/pkgs8/* unix/pkgs/* win/Debug* win/Release* win/*.manifest win/pkgs8/* win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmakehlp.out win/nmhlp-out.txt |
Changes to .gitignore.
︙ | ︙ | |||
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 | libtommath/*.tex macosx/configure unix/autoMkindex.tcl unix/dltest.marker unix/dltest/embtest unix/tcl.pc unix/tclIndex unix/pkgs/* win/Debug* win/Release* win/*.manifest win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmakehlp.out win/nmhlp-out.txt | > > | 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | libtommath/*.tex macosx/configure unix/autoMkindex.tcl unix/dltest.marker unix/dltest/embtest unix/tcl.pc unix/tclIndex unix/pkgs8/* unix/pkgs/* win/Debug* win/Release* win/*.manifest win/pkgs8/* win/pkgs/* win/coffbase.txt win/tcl.hpj win/nmakehlp.out win/nmhlp-out.txt |
Added changes.md.
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | # Tcl/Tk 9.0b2 Release Announcement April ??, 2024 The Tcl Core Team is pleased to announce the 9.0b2 releases of the Tcl dynamic language and the Tk graphical interface package. These are the second beta releases of Tcl 9.0 and Tk 9.0. More details can be found below. We would like to express our gratitude to all those who submit bug reports and patches. This information is invaluable in enabling us to identify and eliminate problems in the core. Such reports can be submitted here. https://core.tcl-lang.org/tcl/ticket https://core.tcl-lang.org/tk/ticket We ask that you log in (anonymous if you wish) to create tickets. This deters abuse of the ticketing system. ## Contents 1. [Where to get the new releases](#wheretoget) 2. [General Summary](#summary) 3. [Some of the most noteworthy changes](#changes) 4. [Tcl Improvement Proposals (TIPs)](#tips) 5. [Additional support resources](#support) 6. [For additional information](#info) ## <a id="wheretoget">1.</a> Where to get the new releases Tcl/Tk 9.0b2 sources are freely available as open source from the Tcl SourceForge project's file distribution area: https://sourceforge.net/projects/tcl/files/ This distribution is source code only. We keep links to some third parties offering pre-built binaries for various systems here: https://www.tcl-lang.org/software/tcltk/bindist.html ## <a id="summary">2.</a> General Summary These are new major versions of both Tcl and Tk. There are new features to be enjoyed. There are incompatibilities to be considered. The list of both is long and detailed and not fully included here. We believe many scripts written for Tcl 8 will run unchanged in Tcl 9. We believe many more can be modified in small and simple ways to produce a new script that runs in both Tcl 8 and Tcl 9. We expect that extensions and applications using the public C APIs of Tcl and Tk will involve more effort, but that it is still within reasonable reach to produce source code supporting both Tcl 8 and Tcl 9 while both releases remain in widespread use. These are beta releases. The developers believe the new feature set is complete enough and the code quality is high enough that it is time for a larger audience of Tcl/Tk users to give them a try and report back to the developers what difficulties need resolution before stable releases of Tcl/Tk 9.0.0. The experiences of Tcl/Tk 8 users adapting their code to the beta releases of Tcl/Tk 9 will shape the final interfaces of Tcl/Tk 9.0.0, and will determine the need for possible Tcl/Tk 8.7 releases that might supply additional lifecycle and migration support. It is not recommended to deploy these beta releases directly to mission critical use without significant testing and review. ## <a id="changes">3.</a> Some of the most noteworthy changes Tcl 9: * 64-bit capacity: Data values larger than 2Gb * Internationalization of text - Full Unicode range of codepoints - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. - [encoding] options -profile, -failindex manage encoding of I/O. - [msgcat] supports custom locale search list - [source] defaults to -encoding utf-8 * Zip filesystems and attached archives. * Unix notifiers available using epoll() or kqueue() - relieves limits on file descriptors imposed by legacy select() * Notable incompatibilities - Unqualified varnames resolved in current namespace, not global. - No --disable-threads build option. Always thread-enabled. - I/O malencoding default response: raise error (-profile strict) - Windows platform needs Windows 7 or Windows Server 2008 R2 or later - Ended interpretation of ~ as home directory in pathnames - Removed the "identity" encoding - $::tcl_precision no longer controls string generation of doubles - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes - Removed subcommands [trace variable|vdelete|vinfo] - No -eofchar option for channels anymore for writing. - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. * Incompatibilities in C public interface - Many arguments expanded type from int to Tcl_Size - Ended support for Tcl_ChannelTypeVersion less than 5 - Introduced versioning of the Tcl_ObjType struct - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support - Removed routines: Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(), Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(), Tcl_(Get|Set)DefaultEncodingDir(), Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch() * New commands - [array default], [array for] - [coroinject], [coroprobe] - [clock add weekdays] - [const], [info const*] - [dict getdefault] - [file tempdir], [file home], [file tildeexpand] - [info commandtype] - [ledit] - [lpop] - [lremove] - [lseq] - [package files] - [string insert], [string is dict] - [tcl::process] - [*::build-info] * New command options - [regsub ... -command ...] - [lsearch ... -stride ...] - [clock scan ... -validate ...] - [socket ... -nodelay ... -keepalive ...] - [vwait] controlled by several new options * Numbers - 0NNN format is no longer octal interpretation. Use 0oNNN. - 0dNNNN format to compel decimal interpretation. - NN_NNN_NNN, underscores in numbers for optional readability - Functions: isinf() isnan() isnormal() issubnormal() isunordered() - [fpclassify] - Function int() no longer truncates to word size * tcl::oo facilities - private variable and methods - [method -export], [method -unexport] Tk 9: * Many improvements to use of platform features and conventions. - Built-in widgets and themes are scaling-aware. - Improved support of two-finger gestures, where available - The [tk windowingsystem] "aqua" needs macOS 10.10 or later * New commands and options - [tk sysnotify]: access to the OS notifications system - [tk systray]: access to the OS tray facility - [tk print]: access to the OS printing facility * Widget options - New ttk::progressbar option: -text - [$frame ... -backgroundimage $img -tile $bool] - [$menu id], [$menu add|insert ... ?$id? ...] - [$image get ... -withalpha ...] - All indices now accept the forms "end", "end-int", "int+|-int" * Improved widget appearance - ttk::notebook with nondefault tab positions * Images - Partial SVG support - Read/write access to photo image metadata ## <a id="tips">4.</a> Tcl Improvement Proposals (TIPs) Each new user-visible feature in Tcl or Tk should find its origins in a Tcl Improvement Proposal (TIP). TIPs are published, edited, considered and voted in public, and should contain valuable information about how a feature came to be the way it is. See the full collection here: https://tip.tcl-lang.org/ ## <a id="support">5.</a> Additional support resources See the following links for an accumulation of migration advice: https://core.tcl-lang.org/tcl/wiki?name=Migrating+C+extensions+to+Tcl+9 https://core.tcl-lang.org/tcl/wiki?name=Migrating+scripts+to+Tcl+9 There has been much progress already porting many known applications, extensions, and packages in the Tcl world to compatibility with Tcl/Tk 9: https://wiki.tcl-lang.org/page/Apps+confirmed+to+work+with+Tcl+9 https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9 ## <a id="info">6.</a> For additional information: Please visit the Tcl Developer Xchange web site: https://www.tcl-lang.org/ This site contains a variety of information about Tcl/Tk in general, the core Tcl and Tk distributions, Tcl development tools, and much more. -- Tcl Core Team and Maintainers Don Porter, Tcl Core Release Manager |
Changes to doc/CrtAlias.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_CreateAlias 3 7.6 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | '\" '\" Copyright (c) 1995-1996 Sun Microsystems, Inc. '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" .TH Tcl_CreateAlias 3 7.6 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_IsSafe, Tcl_CreateChild, Tcl_GetChild, Tcl_GetParent, Tcl_GetInterpPath, Tcl_CreateAlias, Tcl_CreateAliasObj, Tcl_GetAliasObj, Tcl_ExposeCommand, Tcl_HideCommand \- manage multiple Tcl interpreters, aliases and hidden commands .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp int \fBTcl_IsSafe\fR(\fIinterp\fR) .sp |
︙ | ︙ | |||
32 33 34 35 36 37 38 | \fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd, argc, argv\fR) .sp int \fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd, objc, objv\fR) .sp | < < < < | 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | \fBTcl_CreateAlias\fR(\fIchildInterp, childCmd, targetInterp, targetCmd, argc, argv\fR) .sp int \fBTcl_CreateAliasObj\fR(\fIchildInterp, childCmd, targetInterp, targetCmd, objc, objv\fR) .sp int \fBTcl_GetAliasObj\fR(\fIinterp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objvPtr\fR) .sp int \fBTcl_ExposeCommand\fR(\fIinterp, hiddenCmdName, cmdName\fR) .sp |
︙ | ︙ | |||
83 84 85 86 87 88 89 | This storage is owned by the caller. .AP Tcl_Interp **targetInterpPtr in Pointer to location to store the address of the interpreter where a target command is defined for an alias. .AP "const char" **targetCmdPtr out Pointer to location to store the address of the name of the target command for an alias. | | | | | | < | < | < | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | This storage is owned by the caller. .AP Tcl_Interp **targetInterpPtr in Pointer to location to store the address of the interpreter where a target command is defined for an alias. .AP "const char" **targetCmdPtr out Pointer to location to store the address of the name of the target command for an alias. .AP "Tcl_Size \&| int" *objcPtr out Pointer to location to store count of additional value arguments to be passed to the alias. The location is in storage owned by the caller. If it points to a variable which type is not \fBTcl_Size\fR, a compiler warning will be generated. If your extensions is compiled with -DTCL_8_API, this function will return TCL_ERROR for aliases with more than INT_MAX value arguments, otherwise expect it to crash .AP Tcl_Obj ***objvPtr out Pointer to location to store a vector of Tcl_Obj structures, the additional arguments to pass to an alias command. The location is in storage owned by the caller, the vector of Tcl_Obj structures is owned by the called function. .AP "const char" *cmdName in Name of an exposed command to hide or create. |
︙ | ︙ | |||
164 165 166 167 168 169 170 | \fItargetInterp\fR. Any two interpreters can be used, without any restrictions on how they are related. .PP \fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except that it takes a vector of values to pass as additional arguments instead of a vector of strings. .PP | > | | < < < < | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | \fItargetInterp\fR. Any two interpreters can be used, without any restrictions on how they are related. .PP \fBTcl_CreateAliasObj\fR is similar to \fBTcl_CreateAlias\fR except that it takes a vector of values to pass as additional arguments instead of a vector of strings. .PP \fBTcl_GetAliasObj\fR returns information in the form of a pointer to a vector of Tcl_Obj structures about an alias \fIaliasName\fR in \fIinterp\fR. Any of the result fields can be \fBNULL\fR, in which case the corresponding datum is not returned. If a result field is non\-\fBNULL\fR, the address indicated is set to the corresponding datum. For example, if \fItargetCmdPtr\fR is non\-\fBNULL\fR it is set to a pointer to the string containing the name of the target command. .PP \fBTcl_ExposeCommand\fR moves the command named \fIhiddenCmdName\fR from the set of hidden commands to the set of exposed commands, putting it under the name \fIcmdName\fR. \fIHiddenCmdName\fR must be the name of an existing hidden command, or the operation will return \fBTCL_ERROR\fR and leave an error message as the result of \fIinterp\fR. |
︙ | ︙ |
Changes to doc/IntObj.3.
1 2 3 4 5 6 7 8 9 10 | '\" '\" Copyright (c) 1996-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. '\" .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME | | > > > > > | 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 | '\" '\" Copyright (c) 1996-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. '\" .TH Tcl_IntObj 3 8.5 Tcl "Tcl Library Procedures" .so man.macros .BS .SH NAME Tcl_NewIntObj, Tcl_NewLongObj, Tcl_NewWideIntObj, Tcl_NewWideUIntObj, Tcl_SetIntObj, Tcl_SetLongObj, Tcl_SetWideIntObj, Tcl_SetWideUIntObj, Tcl_GetIntFromObj, Tcl_GetIntForIndex, Tcl_GetLongFromObj, Tcl_GetWideIntFromObj, Tcl_GetWideUIntFromObj, Tcl_NewBignumObj, Tcl_SetBignumObj, Tcl_GetBignumFromObj, Tcl_TakeBignumFromObj \- manipulate Tcl values as integers .SH SYNOPSIS .nf \fB#include <tcl.h>\fR .sp Tcl_Obj * \fBTcl_NewIntObj\fR(\fIintValue\fR) .sp Tcl_Obj * \fBTcl_NewLongObj\fR(\fIlongValue\fR) .sp Tcl_Obj * \fBTcl_NewWideIntObj\fR(\fIwideValue\fR) .sp Tcl_Obj * \fBTcl_NewWideUIntObj\fR(\fIuwideValue\fR) .sp \fBTcl_SetIntObj\fR(\fIobjPtr, intValue\fR) .sp \fBTcl_SetLongObj\fR(\fIobjPtr, longValue\fR) .sp \fBTcl_SetWideIntObj\fR(\fIobjPtr, wideValue\fR) .sp \fBTcl_SetWideUIntObj\fR(\fIobjPtr, uwideValue\fR) .sp int \fBTcl_GetIntFromObj\fR(\fIinterp, objPtr, intPtr\fR) .sp int \fBTcl_GetIntForIndex\fR(\fIinterp, objPtr, endValue, indexPtr\fR) .sp |
︙ | ︙ | |||
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | \fBTcl_GetIntForIndex\fR will return this when the input value is "end". .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR, this refers to the value from which to retrieve an integral value. .AP Tcl_Interp *interp in/out When non-NULL, an error message is left here when integral value | > > > | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 | \fBTcl_GetIntForIndex\fR will return this when the input value is "end". .AP int intValue in Integer value used to initialize or set a Tcl value. .AP long longValue in Long integer value used to initialize or set a Tcl value. .AP Tcl_WideInt wideValue in Wide integer value used to initialize or set a Tcl value. .AP Tcl_WideUInt uwideValue in Unsigned wide integer value used to initialize or set a Tcl value. .AP Tcl_Obj *objPtr in/out For \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, \fBTcl_SetWideUIntObj\fR, and \fBTcl_SetBignumObj\fR, this points to the value in which to store an integral value. For \fBTcl_GetIntFromObj\fR, \fBTcl_GetLongFromObj\fR, \fBTcl_GetWideIntFromObj\fR, \fBTcl_GetBignumFromObj\fR, and \fBTcl_TakeBignumFromObj\fR, this refers to the value from which to retrieve an integral value. .AP Tcl_Interp *interp in/out When non-NULL, an error message is left here when integral value |
︙ | ︙ | |||
116 117 118 119 120 121 122 | 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be \fBlong long int\fR, or something else. The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, | | | | | | | | | | | | 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 | 64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending on the platform and the C compiler, the actual type might be \fBlong long int\fR, or something else. The \fBmp_int\fR type is a multiple-precision integer type defined by the LibTomMath multiple-precision integer library. .PP The \fBTcl_NewIntObj\fR, \fBTcl_NewLongObj\fR, \fBTcl_NewWideIntObj\fR, \fBTcl_NewWideUIntObj\fR, and \fBTcl_NewBignumObj\fR routines each create and return a new Tcl value initialized to the integral value of the argument. The returned Tcl value is unshared. .PP The \fBTcl_SetIntObj\fR, \fBTcl_SetLongObj\fR, \fBTcl_SetWideIntObj\fR, \fBTcl_SetWideUIntObj\fR, and \fBTcl_SetBignumObj\fR routines each set the value of an existing Tcl value pointed to by \fIobjPtr\fR to the integral value provided by the other argument. The \fIobjPtr\fR argument must point to an unshared Tcl value. Any attempt to set the value of a shared Tcl value violates Tcl's copy-on-write policy. Any existing string representation or internal representation in the unshared Tcl value will be freed as a consequence of setting the new value. .PP The \fBTcl_GetIntForIndex\fR routine attempts to retrieve an index value from the Tcl value \fIobjPtr\fR. If the attempt succeeds, then \fBTCL_OK\fR is returned, and the value is written to the storage provided by the caller. The attempt might fail if \fIobjPtr\fR does not hold an index value. If the attempt fails, then \fBTCL_ERROR\fR is returned, and if \fIinterp\fR is non-NULL, |
︙ | ︙ |
Changes to doc/chan.n.
︙ | ︙ | |||
29 30 31 32 33 34 35 | on the channel failed because it would have otherwise caused the process to block, and 0 otherwise. Each Tcl channel is in blocking mode unless configured otherwise. .\" METHOD: close .TP \fBchan close \fIchannelName\fR ?\fIdirection\fR? . | | | | < < < | | | | | | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | on the channel failed because it would have otherwise caused the process to block, and 0 otherwise. Each Tcl channel is in blocking mode unless configured otherwise. .\" METHOD: close .TP \fBchan close \fIchannelName\fR ?\fIdirection\fR? . Closes and destroys the named channel deleting any existing event handlers established for the channel. The command returns the empty string. If \fIdirection\fR is given, it is \fBread\fR, or \fBwrite\fR, or any unique abbreviation of those words, and only that side of the channel is closed. I.e. a read-write channel may become read-only or write-only. Closing a read-only channel for reading, or closing a write-only channel for writing is the same as simply closing the channel. It is an error to close a read-only channel for writing or to close a write-only channel for reading. .RS .PP When a channel is closed for writing, any buffered output on the channel is flushed. When a channel is closed for reading, any buffered input is discarded. When a channel is destroyed the underlying resource is closed and the channel is thereafter unavailable. .PP |
︙ | ︙ | |||
86 87 88 89 90 91 92 | .QW \fB0\fR restores the previous behavior. .RE .\" METHOD: configure .TP \fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . | | | | | | 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 | .QW \fB0\fR restores the previous behavior. .RE .\" METHOD: configure .TP \fBchan configure \fIchannelName\fR ?\fIoptionName\fR? ?\fIvalue\fR? ?\fIoptionName value\fR?... . Configures or retrieves the configuration of the channel \fIchannelName\fR. .RS .PP If no \fIoptionName\fR or \fIvalue\fR arguments are given, \fBchan configure\fR returns a dictionary of option names and values for the channel. If \fIoptionName\fR is supplied without a \fIvalue\fR, \fBchan configure\fR returns the current value of the named option. If one or more pairs of \fIoptionName\fR and \fIvalue\fR are supplied, \fBchan configure\fR sets each of the named options to the corresponding \fIvalue\fR and returns the empty string. .PP The options described below are supported for all channels. Each type of channel may provide additional options. Those options are described in the relevant documentation. For example, additional options are documented for \fBsocket\fR, and also for serial devices at \fBopen\fR. .\" OPTION: -blocking .TP \fB\-blocking\fI boolean\fR . If \fB\-blocking\fR is set to \fBtrue\fR (default), reading the channel or writing to it may cause the process to block indefinitely. Otherwise, operations such as \fBchan gets\fR, \fBchan read\fR, \fBchan puts\fR, \fBchan flush\fR, and \fBchan close\fR take care not to block. Non-blocking mode in general requires that the event loop is entered, e.g. by calling \fBTcl_DoOneEvent\fR or \fBvwait\fR or by using Tk, to give Tcl a chance to process events on the channel. .\" OPTION: -buffering .TP \fB\-buffering\fI newValue\fR . If \fInewValue\fR is \fBfull\fR, which is the default, output is buffered |
︙ | ︙ | |||
131 132 133 134 135 136 137 | .TP \fB\-buffersize\fI newSize\fR . \fInewSize\fR, an integer no greater than one million, is the size in bytes of any input or output buffers subsequently allocated for this channel. .\" OPTION: -encoding .TP | | | | 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 | .TP \fB\-buffersize\fI newSize\fR . \fInewSize\fR, an integer no greater than one million, is the size in bytes of any input or output buffers subsequently allocated for this channel. .\" OPTION: -encoding .TP \fB\-encoding\fR \fIname\fR . Sets the encoding of the channel to \fIname\fR which should be one of the names returned by \fBencoding names\fR, or .QW \fBbinary\fR \&. Input is converted from the encoding into Unicode, and output is converted from Unicode to the encoding. .RS .PP \fBbinary\fR is an alias for \fBiso8859-1\fR. This alone is not sufficient for |
︙ | ︙ | |||
190 191 192 193 194 195 196 | output, e.g. with \fBchan puts\fR, each line feed is translated to the external end-of-line character. The default translation, \fBauto\fR, handles all the common cases, and \fB\-translation\fR provides explicit control over the end-of-line character. .RS .PP Returns the input translation for a read-only channel, the output translation | | | 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | output, e.g. with \fBchan puts\fR, each line feed is translated to the external end-of-line character. The default translation, \fBauto\fR, handles all the common cases, and \fB\-translation\fR provides explicit control over the end-of-line character. .RS .PP Returns the input translation for a read-only channel, the output translation for a write-only channel, and both the input translation and the output translation for a read-write channel. When two translations are given, they are the input and output translation, respectively. When only one translation is given for a read-write channel, it is the translation for both input and output. The following values are currently supported: .IP \fBauto\fR The default. For input each occurrence of a line feed (\fBlf\fR), carriage return (\fBcr\fR), or carriage return followed by a line feed (\fBcrlf\fR) is |
︙ | ︙ | |||
339 340 341 342 343 344 345 | \fIscript\fR is evaluated at the global level in the interpreter it was established in. Any resulting error is handled in the background, i.e. via \fBinterp bgerror\fR. In order to prevent an endless loop due to a buggy handler, the handler is deleted if \fIscript\fR returns an error so that it is not evaluated again. .PP Without an event handler, \fBchan gets\fR or \fBchan read\fR on a channel in | | | > | | > > > | > | < < > > > < | | | | | < | | < | | | > > | | > > > | > > > > > > > > > | < > | > > > | > > > > > > > > > | 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 | \fIscript\fR is evaluated at the global level in the interpreter it was established in. Any resulting error is handled in the background, i.e. via \fBinterp bgerror\fR. In order to prevent an endless loop due to a buggy handler, the handler is deleted if \fIscript\fR returns an error so that it is not evaluated again. .PP Without an event handler, \fBchan gets\fR or \fBchan read\fR on a channel in blocking mode may block until data becomes available, during which the thread is unable to perform other work or respond to events on other channels. This could cause the application to appear to .QW "freeze up" \&. Channel event handlers allow events on the channel to direct channel handling so that the reader or writer can continue to perform other processing while waiting for a channel to become available and then handle channel operations when the channel is ready for the operation. .PP A channel is considered to be readable if there is unread data available on the underlying device. A channel is also considered to be readable if there is unread data in an input buffer, except in the special case where the most recent attempt to read from the channel was a \fBchan gets\fR call that could not find a complete line in the input buffer. This feature allows a file to be read a line at a time in non-blocking mode using events. A channel is also considered to be readable if an end of file or error condition is present on the underlying file or device. It is important for \fIscript\fR to check for these conditions and handle them appropriately; for example, if there is no special check for end of file, an infinite loop may occur where \fIscript\fR reads no data, returns, and is immediately invoked again. .PP A channel is considered to be writable if at least one byte of data can be written to the underlying file or device without blocking, or if an error condition is present. Note that client sockets opened in asynchronous mode become writable when they become connected or if the connection fails. .PP Event-driven channel handling works best for channels in non-blocking mode. A channel in blocking mode blocks when \fBchan puts\fR writes more data than the channel can accept at the moment, and when \fBchan gets\fR or \fBchan read\fR requests more data than is currently available. When a channel blocks, the thread can not do any other processing or service any other events. A channel in non-blocking mode allows a thread to carry on with other work and get back to the channel at the right time. .RE .\" METHOD: flush .TP \fBchan flush \fIchannelName\fR . For a channel in blocking mode, flushes all buffered output to the destination, and then returns. For a channel in non-blocking mode, returns immediately while all buffered output is flushed in the background as soon as possible. .\" METHOD: gets .TP \fBchan gets \fIchannelName\fR ?\fIvarName\fR? . Reads a line from the channel consisting of all characters up to the next end-of-line sequence or until end of file is seen. The line feed character corresponding to end-of-line sequence is not included as part of the line. If the \fIvarName\fR argument is specified, the line is stored in the variable of that name and the command returns the length of the line. If \fIvarName\fR is not specified, the command returns the line itself as the result of the command. .RS .PP If a complete line is not available and the channel is not at EOF, the command will block in the case of a blocking channel. For non-blocking channels, the command will return the empty string as the result in the case of \fIvarName\fR not specified and -1 if it is. .RE .RS .PP If a blocking channel is already at EOF, the command returns an empty string if \fIvarName\fR is not specified. Note an empty string result can also be returned when a blank line (no characters before the next end of line sequence). The two cases can be distinguished by calling the \fBchan eof\fR command to check for end of file. If \fIvarName\fR is specified, the command returns -1 on end of file. There is no ambiguity in this case because blank lines result in 0 being returned. .RE .RS .PP If a non-blocking channel is already at EOF, the command returns an empty line if \fIvarName\fR is not specified. This can be distinguished from an empty line being returned by either a blank line being read or a full line not being available through the use of the \fBchan eof\fR and \fBchan blocked\fR commands. If \fBchan eof\fR returns true, the channel is at EOF. If \fBchan blocked\fR returns true, a full line was not available. If both commands return false, an empty line was read. If \fIvarName\fR was specified for a non-bocking channel at EOF, the command returns -1. This can be distinguished from full line not being available either by \fBchan eof\fR or \fBchan blocked\fR as above. Note that when \fIvarName\fR is specified, there is no need to distinguish between eof and blank lines as the latter will result in the command returning 0. .PP If the encoding profile \fBstrict\fR is in effect for the channel, the command will raise an exception with the POSIX error code \fBEILSEQ\fR if any encoding errors are encountered in the channel input data. The file pointer remains unchanged and it is possible to introspect, and in some cases recover, by changing the encoding in use. See \fBENCODING ERROR EXAMPLES\fR later. .RE .\" METHOD: names .TP \fBchan names\fR ?\fIpattern\fR? . Returns a list of all channel names, or if \fIpattern\fR is given, only those names that match according to the rules of \fBstring match\fR. |
︙ | ︙ | |||
505 506 507 508 509 510 511 | \fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelName\fR? \fIstring\fR . Writes \fIstring\fR and a line feed to the channel. If \fB\-nonewline\fR is given, the trailing line feed is not written. The default channel is \fBstdout\fR. .RS .PP | | | | | | | | < | | | | | > > > > > | > > > > > > > > > > > > > > > | 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 | \fBchan puts\fR ?\fB\-nonewline\fR? ?\fIchannelName\fR? \fIstring\fR . Writes \fIstring\fR and a line feed to the channel. If \fB\-nonewline\fR is given, the trailing line feed is not written. The default channel is \fBstdout\fR. .RS .PP Each line feed in the output is translated to the appropriate end of line sequence as per the \fB\-translation\fR configuration setting of the channel. .PP Because Tcl internally buffers output, characters written to a channel may not immediately be available at the destination. Tcl normally delays output until the buffer is full or the channel is closed. \fBchan flush\fR forces output in the direction of the destination. .PP When the output for a channel in blocking mode fills up, \fBchan puts\fR blocks until space in the buffer is available again. On the other hand for a channel in non-blocking mode, it returns immediately and the data is written in the background as fast possible, constrained by the speed at which as the destination accepts it. Output to a channel in non-blocking mode only works properly when the application enters the event loop. When a channel is in non-blocking mode, Tcl's internal buffers can hold an arbitrary amount of data, possibly consuming a large amount of memory. To avoid wasting memory, channels in non-blocking mode should normally be handled using \fBchan event\fR, where the application only invokes \fBchan puts\fR after being notified through a file event handler that the channel is ready for more output data. .PP The command will raise an error exception with POSIX error code \fBEILSEQ\fR if the encoding profile \fBstrict\fR is in effect for the channel and the output data cannot be encoded in the encoding configured for the channel. Data may be partially written to the channel in this case. .RE .\" METHOD: read .TP \fBchan read \fIchannelName\fR ?\fInumChars\fR? .TP \fBchan read \fR?\fB\-nonewline\fR? \fIchannelName\fR . Reads and returns the next \fInumChars\fR characters from the channel. If \fInumChars\fR is omitted, all available characters up to the end of the file are read, or if the channel is in non-blocking mode, all currently-available characters are read. If there is an error on the channel, reading ceases and an error is returned. If \fInumChars\fR is not given, \fB\-nonewline\fR may be given, causing any trailing line feed to be trimmed. .RS .PP If the channel is in non-blocking mode, fewer characters than requested may be returned. If the channel is configured to use a multi-byte encoding, bytes that do not form a complete character are retained in the buffers until enough bytes to complete the character accumulate, or the end of the data is reached. \fB\-nonewline\fR is ignored if characters are returned before reaching the end of the file. .PP Each end-of-line sequence according to the value of \fB\-translation\fR is translated into a line feed. .PP When reading from a serial port, most applications should configure the serial port channel to be in non-blocking mode, but not necessarily use an event handler since most serial ports are comparatively slow. It is entirely possible to get a \fBreadable\fR event for each individual character. In blocking mode, \fBchan read\fR blocks forever when reading to the end of the data if there is no \fBchan configure -eofchar\fR configured for the channel. .PP If the encoding profile \fBstrict\fR is in effect for the channel, the command will raise an exception with the POSIX error code \fBEILSEQ\fR if any encoding errors are encountered in the channel input data. If the channel is in blocking mode, the error is thrown after advancing the file pointer to the beginning of the invalid data. The successfully decoded leading portion of the data prior to the error location is returned as the value of the \fB\-data\fR key of the error option dictionary. If the channel is in non-blocking mode, the successfully decoded portion of data is returned by the command without an error exception being raised. A subsequent read will start at the invalid data and immediately raise a \fBEILSEQ\fR POSIX error exception. Unlike the blocking channel case, the \fB\-data\fR key is not present in the error option dictionary. In the case of exception thrown due to encoding errors, it is possible to introspect, and in some cases recover, by changing the encoding in use. See \fBENCODING ERROR EXAMPLES\fR later. .RE .\" METHOD: seek .TP \fBchan seek \fIchannelName offset\fR ?\fIorigin\fR? . Sets the current position for the data in the channel to integer \fIoffset\fR bytes relative to \fIorigin\fR. A negative offset moves the current position |
︙ | ︙ | |||
597 598 599 600 601 602 603 604 605 606 607 608 609 610 | \fBchan truncate \fIchannelName\fR ?\fIlength\fR? . Flushes the channel and truncates the data in the channel to \fIlength\fR bytes, or to the current position in bytes if \fIlength\fR is omitted. . .SH EXAMPLES .SS "SIMPLE CHANNEL OPERATION EXAMPLES" .PP In the following example a file is opened using the encoding CP1252, which is common on Windows, searches for a string, rewrites that part, and truncates the file two lines later. .PP .CS set f [open somefile.txt r+] | > > > > > > > | 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 | \fBchan truncate \fIchannelName\fR ?\fIlength\fR? . Flushes the channel and truncates the data in the channel to \fIlength\fR bytes, or to the current position in bytes if \fIlength\fR is omitted. . .SH EXAMPLES .SS "SIMPLE CHANNEL OPERATION EXAMPLES" .PP Instruct Tcl to always send output to \fBstdout\fR immediately, whether or not it is to a terminal: .PP .CS \fBfconfigure\fR stdout -buffering none .CE .PP In the following example a file is opened using the encoding CP1252, which is common on Windows, searches for a string, rewrites that part, and truncates the file two lines later. .PP .CS set f [open somefile.txt r+] |
︙ | ︙ | |||
630 631 632 633 634 635 636 637 638 639 640 641 642 643 | } \fI# Save offset of start of next line for later\fR set offset [\fBchan tell\fR $f] } \fBchan close\fR $f .CE .PP A network server that echoes its input line-by-line without preventing servicing of other connections at the same time: .PP .CS # This is a very simple logger... proc log message { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 | } \fI# Save offset of start of next line for later\fR set offset [\fBchan tell\fR $f] } \fBchan close\fR $f .CE .PP This example illustrates flushing of a channel. The user is prompted for some information. Because the standard input channel is line buffered, it must be flushed for the user to see the prompt. .PP .CS chan puts -nonewline "Please type your name: " \fBchan flush\fR stdout chan gets stdin name chan puts "Hello there, $name!" .CE .PP This example reads a file one line at a time and prints it out with the current line number attached to the start of each line. .PP .CS set chan [open "some.file.txt"] set lineNumber 0 while {[\fBchan gets\fR $chan line] >= 0} { chan puts "[incr lineNumber]: $line" } chan close $chan .CE .PP In this example illustrating event driven reads, \fBGetData\fR will be called with the channel as an argument whenever $chan becomes readable. The \fBread\fR call will read whatever binary data is currently available without blocking. Here the channel has the fileevent removed when an end of file occurs to avoid being continually called (see above). Alternatively the channel may be closed on this condition. .PP .CS proc GetData {chan} { set data [chan read $chan] chan puts "[string length $data] $data" if {[chan eof $chan]} { chan event $chan readable {} } } chan configure $chan -blocking 0 -encoding binary \fBchan event\fR $chan readable [list GetData $chan] .CE .PP The next example is similar but uses \fBchan gets\fR to read line-oriented data. .PP .CS proc GetData {chan} { if {[chan gets $chan line] >= 0} { chan puts $line } if {[chan eof $chan]} { chan close $chan } } chan configure $chan -blocking 0 -buffering line -translation crlf \fBchan event\fR $chan readable [list GetData $chan] .CE .PP A network server that echoes its input line-by-line without preventing servicing of other connections at the same time: .PP .CS # This is a very simple logger... proc log message { |
︙ | ︙ | |||
667 668 669 670 671 672 673 674 675 676 677 678 679 680 | } # Create the server socket and enter the event-loop to wait # for incoming connections... socket -server connect 12345 vwait forever .CE .SS "CHANNEL COPY EXAMPLES" .PP The first example transfers the contents of one channel exactly to another. Note that when copying one file to another, it is better to use \fBfile copy\fR which also copies file metadata (e.g. the file access permissions) where possible. .PP | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 | } # Create the server socket and enter the event-loop to wait # for incoming connections... socket -server connect 12345 vwait forever .CE .PP The following example reads a PPM-format image from a file combining ASCII and binary content. .PP .CS # Open the file and put it into Unix ASCII mode set f [open teapot.ppm] \fBchan configure\fR $f -encoding ascii -translation lf # Get the header if {[chan gets $f] ne "P6"} { error "not a raw\-bits PPM" } # Read lines until we have got non-comment lines # that supply us with three decimal values. set words {} while {[llength $words] < 3} { chan gets $f line if {[string match "#*" $line]} continue lappend words {*}[join [scan $line %d%d%d]] } # Those words supply the size of the image and its # overall depth per channel. Assign to variables. lassign $words xSize ySize depth # Now switch to binary mode to pull in the data, # one byte per channel (red,green,blue) per pixel. \fBchan configure\fR $f -translation binary set numDataBytes [expr {3 * $xSize * $ySize}] set data [chan read $f $numDataBytes] close $f .CE .SS "FILE SEEK EXAMPLES" .PP Read a file twice: .PP .CS set f [open file.txt] set data1 [chan read $f] \fBchan seek\fR $f 0 set data2 [chan read $f] chan close $f # $data1 eq $data2 if the file wasn't updated .CE .PP Read the last 10 bytes from a file: .PP .CS set f [open file.data] # This is guaranteed to work with binary data but # may fail with other encodings... chan configure $f -translation binary \fBchan seek\fR $f -10 end set data [chan read $f 10] chan close $f .CE .PP Read a line from a file channel only if it starts with \fBfoobar\fR: .PP .CS # Save the offset in case we need to undo the read... set offset [\fBtell\fR $chan] if {[read $chan 6] eq "foobar"} { gets $chan line } else { set line {} # Undo the read... seek $chan $offset } .CE .SS "ENCODING ERROR EXAMPLES" .PP The example below illustrates handling of an encoding error encountered during channel input. First, creation of a test file containing the invalid UTF-8 sequence (\fBA \\xC3 B\fR): .PP .CS % set f [open test_A_195_B.txt wb]; chan puts -nonewline $f A\\xC3B; chan close $f .CE .PP An attempt to read the file will result in an encoding error which is then introspected by switching the channel to binary mode. Note in the example that when the error is reported the file position remains unchanged so that the \fBchan gets\fR during recovery returns the full line. .PP .CS % set f [open test_A_195_B.txt r] file384b6a8 % chan configure $f -encoding utf-8 -profile strict % catch {chan gets $f} e d 1 % set d -code 1 -level 0 -errorstack {INNER {invokeStk1 gets file384b6a8}} -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} -errorinfo {...} -errorline 1 % chan tell $f 0 % chan configure $f -encoding binary -profile strict % chan gets $f AÃB .CE .PP The following example is similar to the above but demonstrates recovery after a blocking read. The successfully decoded data "A" is returned in the error options dictionary key \fB\-data\fR. The file position is advanced on the encoding error position 1. The data at the error position is thus recovered by the next \fBchan read\fR command. .PP .CS % set f [open test_A_195_B.txt r] file35a65a0 % chan configure $f -encoding utf-8 -profile strict -blocking 1 % catch {chan read $f} e d 1 % set d -data A -code 1 -level 0 -errorstack {INNER {invokeStk1 read file35a65a0}} -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} -errorinfo {...} -errorline 1 % chan tell $f 1 % chan configure $f -encoding binary -profile strict % chan read $f ÃB % chan close $f .CE .PP Finally the same example, but this time with a non-blocking channel. .PP .CS % set f [open test_A_195_B.txt r] file35a65a0 % chan configure $f -encoding utf-8 -profile strict -blocking 0 % chan read $f A % chan tell $f 1 % catch {chan read $f} e d 1 % set d -code 1 -level 0 -errorstack {INNER {invokeStk1 read file384b228}} -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} -errorinfo {...} -errorline 1 .CE .SS "CHANNEL COPY EXAMPLES" .PP The first example transfers the contents of one channel exactly to another. Note that when copying one file to another, it is better to use \fBfile copy\fR which also copies file metadata (e.g. the file access permissions) where possible. .PP |
︙ | ︙ | |||
754 755 756 757 758 759 760 | \fBchan copy\fR $sok1 $sok2 -command [list Done UP] \fBchan copy\fR $sok2 $sok1 -command [list Done DOWN] vwait done .CE .SH "SEE ALSO" close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n), fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n), | | > > | | 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 | \fBchan copy\fR $sok1 $sok2 -command [list Done UP] \fBchan copy\fR $sok2 $sok1 -command [list Done DOWN] vwait done .CE .SH "SEE ALSO" close(n), eof(n), fblocked(n), fconfigure(n), fcopy(n), file(n), fileevent(n), flush(n), gets(n), open(n), puts(n), read(n), seek(n), socket(n), tell(n), refchan(n), transchan(n), Tcl_StandardChannels(3) .SH KEYWORDS blocking, channel, end of file, events, input, non-blocking, offset, output, readable, seek, stdio, tell, writable '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/close.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME close \- Close an open channel .SH SYNOPSIS \fBclose \fIchannelId\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)? .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | < < | < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME close \- Close an open channel .SH SYNOPSIS \fBclose \fIchannelId\fR ?\fBr\fR(\fBead\fR)|\fBw\fR(\fBrite\fR)? .BE .SH DESCRIPTION .PP The \fBclose\fR command has been superceded by the \fBchan close\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/eof.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME eof \- Check for end of file condition on channel .SH SYNOPSIS \fBeof \fIchannelId\fR .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < | < < < < < < < < < < | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME eof \- Check for end of file condition on channel .SH SYNOPSIS \fBeof \fIchannelId\fR .BE .SH DESCRIPTION .PP The \fBeof\fR command has been superceded by the \fBchan eof\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/fblocked.n.
︙ | ︙ | |||
10 11 12 13 14 15 16 | .SH NAME fblocked \- Test whether the last input operation exhausted all available input .SH SYNOPSIS \fBfblocked \fIchannelId\fR .BE .SH DESCRIPTION .PP | | < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < > | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 | .SH NAME fblocked \- Test whether the last input operation exhausted all available input .SH SYNOPSIS \fBfblocked \fIchannelId\fR .BE .SH DESCRIPTION .PP The \fBfblocked\fR command has been superceded by the \fBchan blocked\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/fconfigure.n.
︙ | ︙ | |||
15 16 17 18 19 20 21 | \fBfconfigure \fIchannelId\fR \fBfconfigure \fIchannelId name\fR \fBfconfigure \fIchannelId name value \fR?\fIname value ...\fR? .fi .BE .SH DESCRIPTION .PP | | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 | \fBfconfigure \fIchannelId\fR \fBfconfigure \fIchannelId name\fR \fBfconfigure \fIchannelId name value \fR?\fIname value ...\fR? .fi .BE .SH DESCRIPTION .PP The \fBfconfigure\fR command has been superceded by the \fBchan configure\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" End: |
Changes to doc/fileevent.n.
︙ | ︙ | |||
15 16 17 18 19 20 21 | .SH SYNOPSIS \fBfileevent \fIchannelId \fBreadable \fR?\fIscript\fR? .sp \fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR? .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < | < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | .SH SYNOPSIS \fBfileevent \fIchannelId \fBreadable \fR?\fIscript\fR? .sp \fBfileevent \fIchannelId \fBwritable \fR?\fIscript\fR? .BE .SH DESCRIPTION .PP The \fBfileevent\fR command has been superceded by the \fBchan event\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/flush.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME flush \- Flush buffered output for a channel .SH SYNOPSIS \fBflush \fIchannelId\fR .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < < < < < < | < < < > < < | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME flush \- Flush buffered output for a channel .SH SYNOPSIS \fBflush \fIchannelId\fR .BE .SH DESCRIPTION .PP The \fBflush\fR command has been superceded by the \fBchan flush\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/gets.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME gets \- Read a line from a channel .SH SYNOPSIS \fBgets \fIchannelId\fR ?\fIvarName\fR? .BE .SH DESCRIPTION .PP | | < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | < < | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME gets \- Read a line from a channel .SH SYNOPSIS \fBgets \fIchannelId\fR ?\fIvarName\fR? .BE .SH DESCRIPTION .PP The \fBgets\fR command has been superceded by the \fBchan gets\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/info.n.
︙ | ︙ | |||
55 56 57 58 59 60 61 | .IP \fBcoroutine\fR \fIcommandName\fR was created by \fBcoroutine\fR. .IP \fBensemble\fR \fIcommandName\fR was created by \fBnamespace ensemble\fR. .IP \fBimport\fR \fIcommandName\fR was created by \fBnamespace import\fR. .IP \fBnative\fR | | | 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 | .IP \fBcoroutine\fR \fIcommandName\fR was created by \fBcoroutine\fR. .IP \fBensemble\fR \fIcommandName\fR was created by \fBnamespace ensemble\fR. .IP \fBimport\fR \fIcommandName\fR was created by \fBnamespace import\fR. .IP \fBnative\fR \fIcommandName\fR was created by the \fBTcl_CreateObjCommand\fR interface directly without further registration of the type of command. .IP \fBobject\fR \fIcommandName\fR is the public command that represents an instance of \fBoo::object\fR or one of its subclasses. .IP \fBprivateObject\fR \fIcommandName\fR is the private command, \fBmy\fR by default, that represents an instance of \fBoo::object\fR or one of its subclasses. |
︙ | ︙ |
Changes to doc/puts.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME puts \- Write to a channel .SH SYNOPSIS \fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < | < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME puts \- Write to a channel .SH SYNOPSIS \fBputs \fR?\fB\-nonewline\fR? ?\fIchannelId\fR? \fIstring\fR .BE .SH DESCRIPTION .PP The \fBputs\fR command has been superceded by the \fBchan puts\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/read.n.
︙ | ︙ | |||
14 15 16 17 18 19 20 | .SH SYNOPSIS \fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR .sp \fBread \fIchannelId numChars\fR .BE .SH DESCRIPTION .PP | | < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 | .SH SYNOPSIS \fBread \fR?\fB\-nonewline\fR? \fIchannelId\fR .sp \fBread \fIchannelId numChars\fR .BE .SH DESCRIPTION .PP The \fBread\fR command has been superceded by the \fBchan read\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\"Local Variables: '\"mode: nroff '\"End: |
Changes to doc/seek.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME seek \- Change the access position for an open channel .SH SYNOPSIS \fBseek \fIchannelId offset \fR?\fIorigin\fR? .BE .SH DESCRIPTION .PP | < < < < < | < < < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < > | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME seek \- Change the access position for an open channel .SH SYNOPSIS \fBseek \fIchannelId offset \fR?\fIorigin\fR? .BE .SH DESCRIPTION .PP The \fBseek\fR command has been superceded by the \fBchan seek\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to doc/tell.n.
︙ | ︙ | |||
12 13 14 15 16 17 18 | .SH NAME tell \- Return current access position for an open channel .SH SYNOPSIS \fBtell \fIchannelId\fR .BE .SH DESCRIPTION .PP | < < < < < < < < < < < < < < < < < | < < < < < < < < > < < | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 | .SH NAME tell \- Return current access position for an open channel .SH SYNOPSIS \fBtell \fIchannelId\fR .BE .SH DESCRIPTION .PP The \fBtell\fR command has been superceded by the \fBchan tell\fR command which supports the same syntax and options. .SH "SEE ALSO" chan(n) '\" Local Variables: '\" mode: nroff '\" fill-column: 78 '\" End: |
Changes to generic/tcl.decls.
︙ | ︙ | |||
466 467 468 469 470 471 472 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } | < < < < < | | | 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 | declare 145 { Tcl_HashEntry *Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr) } declare 146 { int Tcl_Flush(Tcl_Channel chan) } declare 149 { int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objvPtr) } declare 150 { void *Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr) } declare 151 { Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, |
︙ | ︙ | |||
876 877 878 879 880 881 882 | } # 284 was reserved, but added in 8.4a2 declare 284 { void Tcl_SetMainLoop(Tcl_MainLoopProc *proc) } | < | > | > > | 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 | } # 284 was reserved, but added in 8.4a2 declare 284 { void Tcl_SetMainLoop(Tcl_MainLoopProc *proc) } declare 285 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr) } # Added in 8.1: declare 286 { void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr) } declare 287 { |
︙ | ︙ | |||
2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 | declare 686 { int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 687 { int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # | > > > > > > > > | | 2356 2357 2358 2359 2360 2361 2362 2363 2364 2365 2366 2367 2368 2369 2370 2371 2372 2373 2374 2375 2376 2377 2378 2379 2380 2381 | declare 686 { int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n) } declare 687 { int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n) } # TIP #648 declare 688 { Tcl_Obj *Tcl_NewWideUIntObj(Tcl_WideUInt wideValue) } declare 689 { void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue) } # ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- # declare 690 { void TclUnusedStubEntry(void) } ############################################################################## # Define the platform specific public Tcl interface. These functions are only # available on the designated platform. |
︙ | ︙ |
Changes to generic/tcl.h.
︙ | ︙ | |||
2333 2334 2335 2336 2337 2338 2339 | #elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE # define Tcl_InitStubs(interp, version, exact) \ (Tcl_InitStubs)(interp, version, \ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ TCL_STUB_MAGIC) #else # define Tcl_InitStubs(interp, version, exact) \ | | | | 2333 2334 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 | #elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE # define Tcl_InitStubs(interp, version, exact) \ (Tcl_InitStubs)(interp, version, \ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ TCL_STUB_MAGIC) #else # define Tcl_InitStubs(interp, version, exact) \ (Tcl_InitStubs)(interp, (((exact)&1) ? (version) : "9.0b2"), \ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \ TCL_STUB_MAGIC) #endif #else #if TCL_MAJOR_VERSION < 9 # error "Please define -DUSE_TCL_STUBS" #elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE # define Tcl_InitStubs(interp, version, exact) \ |
︙ | ︙ |
Changes to generic/tclClock.c.
︙ | ︙ | |||
111 112 113 114 115 116 117 118 119 120 121 122 123 124 | static Tcl_ObjCmdProc ClockAddObjCmd; static int ClockValidDate(DateInfo *, ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); static size_t TzsetIfNecessary(void); static void ClockDeleteCmdProc(void *); static Tcl_ObjCmdProc ClockSafeCatchCmd; /* * Structure containing description of "native" clock commands to create. */ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::<name>". When NULL marks | > | 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | static Tcl_ObjCmdProc ClockAddObjCmd; static int ClockValidDate(DateInfo *, ClockFmtScnCmdArgs *, int stage); static struct tm * ThreadSafeLocalTime(const time_t *); static size_t TzsetIfNecessary(void); static void ClockDeleteCmdProc(void *); static Tcl_ObjCmdProc ClockSafeCatchCmd; static void ClockFinalize(void *); /* * Structure containing description of "native" clock commands to create. */ struct ClockCommand { const char *name; /* The tail of the command name. The full name * is "::tcl::clock::<name>". When NULL marks |
︙ | ︙ | |||
175 176 177 178 179 180 181 182 183 184 185 186 187 188 | const struct ClockCommand *clockCmdPtr; char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ Command *cmdPtr; ClockClientData *data; int i; /* * Safe interps get [::clock] as alias to a parent, so do not need their * own copies of the support routines. */ if (Tcl_IsSafe(interp)) { | > > > > > > > > > | 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 | const struct ClockCommand *clockCmdPtr; char cmdName[50]; /* Buffer large enough to hold the string *::tcl::clock::GetJulianDayFromEraYearMonthDay * plus a terminating NUL. */ Command *cmdPtr; ClockClientData *data; int i; static int initialized = 0; /* global clock engine initialized (in process) */ /* * Register handler to finalize clock on exit. */ if (!initialized) { Tcl_CreateExitHandler(ClockFinalize, NULL); initialized = 1; } /* * Safe interps get [::clock] as alias to a parent, so do not need their * own copies of the support routines. */ if (Tcl_IsSafe(interp)) { |
︙ | ︙ | |||
235 236 237 238 239 240 241 | data->prevUsedLocale = NULL; data->prevUsedLocaleDict = NULL; data->lastBase.timezoneObj = NULL; memset(&data->lastTZOffsCache, 0, sizeof(data->lastTZOffsCache)); | | | 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | data->prevUsedLocale = NULL; data->prevUsedLocaleDict = NULL; data->lastBase.timezoneObj = NULL; memset(&data->lastTZOffsCache, 0, sizeof(data->lastTZOffsCache)); data->defFlags = CLF_VALIDATE; /* * Install the commands. */ #define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */ memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN); |
︙ | ︙ | |||
348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 | for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } if (data->mcLiterals != NULL) { for (i = 0; i < MCLIT__END; ++i) { Tcl_DecrRefCount(data->mcLiterals[i]); } data->mcLiterals = NULL; } if (data->mcLitIdxs != NULL) { for (i = 0; i < MCLIT__END; ++i) { Tcl_DecrRefCount(data->mcLitIdxs[i]); } data->mcLitIdxs = NULL; } ClockConfigureClear(data); Tcl_Free(data->literals); Tcl_Free(data); | > > | 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 | for (i = 0; i < LIT__END; ++i) { Tcl_DecrRefCount(data->literals[i]); } if (data->mcLiterals != NULL) { for (i = 0; i < MCLIT__END; ++i) { Tcl_DecrRefCount(data->mcLiterals[i]); } Tcl_Free(data->mcLiterals); data->mcLiterals = NULL; } if (data->mcLitIdxs != NULL) { for (i = 0; i < MCLIT__END; ++i) { Tcl_DecrRefCount(data->mcLitIdxs[i]); } Tcl_Free(data->mcLitIdxs); data->mcLitIdxs = NULL; } ClockConfigureClear(data); Tcl_Free(data->literals); Tcl_Free(data); |
︙ | ︙ | |||
718 719 720 721 722 723 724 | MsgCtLiterals[i], TCL_AUTO_LENGTH)); } } } /* check or obtain mcDictObj (be sure it's modifiable) */ if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) { | | | 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 | MsgCtLiterals[i], TCL_AUTO_LENGTH)); } } } /* check or obtain mcDictObj (be sure it's modifiable) */ if (opts->mcDictObj == NULL || opts->mcDictObj->refCount > 1) { Tcl_Size ref = 1; /* first try to find locale catalog dict */ if (dataPtr->mcDicts == NULL) { TclSetObjRef(dataPtr->mcDicts, Tcl_NewDictObj()); } Tcl_DictObjGet(NULL, dataPtr->mcDicts, opts->localeObj, &opts->mcDictObj); |
︙ | ︙ | |||
963 964 965 966 967 968 969 | CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE, CLOCK_INIT_COMPLETE }; int optionIndex; /* Index of an option. */ | | | 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 | CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE, CLOCK_INIT_COMPLETE }; int optionIndex; /* Index of an option. */ Tcl_Size i; for (i = 1; i < objc; i++) { if (Tcl_GetIndexFromObj(interp, objv[i++], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", TclGetString(objv[i - 1]), (char *)NULL); return TCL_ERROR; |
︙ | ︙ | |||
3273 3274 3275 3276 3277 3278 3279 | } ClockOperation; static int ClockParseFmtScnArgs( ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ | | | | 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 | } ClockOperation; static int ClockParseFmtScnArgs( ClockFmtScnCmdArgs *opts, /* Result vector: format, locale, timezone... */ TclDateFields *date, /* Extracted date-time corresponding base * (by scan or add) resp. clockval (by format) */ Tcl_Size objc, /* Parameter count */ Tcl_Obj *const objv[], /* Parameter vector */ ClockOperation operation, /* What operation are we doing: format, scan, add */ const char *syntax) /* Syntax of the current command */ { Tcl_Interp *interp = opts->interp; ClockClientData *dataPtr = opts->dataPtr; int gmtFlag = 0; static const char *const options[] = { "-base", "-format", "-gmt", "-locale", "-timezone", "-validate", NULL }; enum optionInd { CLC_ARGS_BASE, CLC_ARGS_FORMAT, CLC_ARGS_GMT, CLC_ARGS_LOCALE, CLC_ARGS_TIMEZONE, CLC_ARGS_VALIDATE }; int optionIndex; /* Index of an option. */ int saw = 0; /* Flag == 1 if option was seen already. */ Tcl_Size i, baseIdx; Tcl_WideInt baseVal; /* Base time, expressed in seconds from the Epoch */ if (operation == CLC_OP_SCN) { /* default flags (from configure) */ opts->flags |= dataPtr->defFlags & CLF_VALIDATE; } else { /* clock value (as current base) */ |
︙ | ︙ | |||
4366 4367 4368 4369 4370 4371 4372 | }; enum unitInd { CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS }; int unitIndex; /* Index of an option. */ | | | 4378 4379 4380 4381 4382 4383 4384 4385 4386 4387 4388 4389 4390 4391 4392 | }; enum unitInd { CLC_ADD_YEARS, CLC_ADD_MONTHS, CLC_ADD_WEEK, CLC_ADD_WEEKS, CLC_ADD_DAYS, CLC_ADD_WEEKDAYS, CLC_ADD_HOURS, CLC_ADD_MINUTES, CLC_ADD_SECONDS }; int unitIndex; /* Index of an option. */ Tcl_Size i; Tcl_WideInt offs; /* even number of arguments */ if ((objc & 1) == 1) { Tcl_WrongNumArgs(interp, 0, objv, syntax); Tcl_SetErrorCode(interp, "CLOCK", "wrongNumArgs", (char *)NULL); return TCL_ERROR; |
︙ | ︙ | |||
4633 4634 4635 4636 4637 4638 4639 4640 4641 4642 4643 | #else #define WCHAR char #define wcslen strlen #define wcscmp strcmp #define wcscpy strcpy #endif #define TZ_INIT_MARKER ((WCHAR *) INT2PTR(-1)) static size_t TzsetIfNecessary(void) { | > > > > > > > > > > > > > > > > < < < < < < < < < < < | 4645 4646 4647 4648 4649 4650 4651 4652 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 | #else #define WCHAR char #define wcslen strlen #define wcscmp strcmp #define wcscpy strcpy #endif #define TZ_INIT_MARKER ((WCHAR *) INT2PTR(-1)) typedef struct ClockTzStatic { WCHAR *was; /* Previous value of TZ. */ #if TCL_MAJOR_VERSION > 8 long long lastRefresh; /* Used for latency before next refresh. */ #else long lastRefresh; /* Used for latency before next refresh. */ #endif size_t epoch; /* Epoch, signals that TZ changed. */ size_t envEpoch; /* Last env epoch, for faster signaling, * that TZ changed via TCL */ } ClockTzStatic; static ClockTzStatic tz = { /* Global timezone info; protected by * clockMutex.*/ TZ_INIT_MARKER, 0, 0, 0 }; static size_t TzsetIfNecessary(void) { const WCHAR *tzNow; /* Current value of TZ. */ Tcl_Time now; /* Current time. */ size_t epoch; /* The tz.epoch that the TZ was read at. */ /* * Prevent performance regression on some platforms by resolving of system time zone: * small latency for check whether environment was changed (once per second) |
︙ | ︙ | |||
4678 4679 4680 4681 4682 4683 4684 | } if (tzNow != NULL && (tz.was == NULL || tz.was == TZ_INIT_MARKER || wcscmp(tzNow, tz.was) != 0)) { tzset(); if (tz.was != NULL && tz.was != TZ_INIT_MARKER) { Tcl_Free(tz.was); } | | > > > > > > > > > > > > > | 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 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 | } if (tzNow != NULL && (tz.was == NULL || tz.was == TZ_INIT_MARKER || wcscmp(tzNow, tz.was) != 0)) { tzset(); if (tz.was != NULL && tz.was != TZ_INIT_MARKER) { Tcl_Free(tz.was); } tz.was = (WCHAR *)Tcl_Alloc(sizeof(WCHAR) * (wcslen(tzNow) + 1)); wcscpy(tz.was, tzNow); epoch = ++tz.epoch; } else if (tzNow == NULL && tz.was != NULL) { tzset(); if (tz.was != TZ_INIT_MARKER) { Tcl_Free(tz.was); } tz.was = NULL; epoch = ++tz.epoch; } else { epoch = tz.epoch; } Tcl_MutexUnlock(&clockMutex); return epoch; } static void ClockFinalize( TCL_UNUSED(void *)) { ClockFrmScnFinalize(); if (tz.was && tz.was != TZ_INIT_MARKER) { Tcl_Free(tz.was); } Tcl_MutexFinalize(&clockMutex); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclClockFmt.c.
︙ | ︙ | |||
22 23 24 25 26 27 28 | static void ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr); static int ClockFmtObj_SetFromAny(Tcl_Interp *, Tcl_Obj *objPtr); static void ClockFmtObj_UpdateString(Tcl_Obj *objPtr); TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); | | > > > | 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | static void ClockFmtObj_FreeInternalRep(Tcl_Obj *objPtr); static int ClockFmtObj_SetFromAny(Tcl_Interp *, Tcl_Obj *objPtr); static void ClockFmtObj_UpdateString(Tcl_Obj *objPtr); TCL_DECLARE_MUTEX(ClockFmtMutex); /* Serializes access to common format list. */ static void ClockFmtScnStorageDelete(ClockFmtScnStorage *fss); #ifndef TCL_CLOCK_FULL_COMPAT #define TCL_CLOCK_FULL_COMPAT 1 #endif /* * Derivation of tclStringHashKeyType with another allocEntryProc */ static Tcl_HashKeyType ClockFmtScnStorageHashKeyType; |
︙ | ︙ | |||
674 675 676 677 678 679 680 | } static void ClockFmtObj_FreeInternalRep( Tcl_Obj *objPtr) { ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); | | | 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 | } static void ClockFmtObj_FreeInternalRep( Tcl_Obj *objPtr) { ClockFmtScnStorage *fss = ObjClockFmtScn(objPtr); if (fss != NULL && initialized) { Tcl_MutexLock(&ClockFmtMutex); /* decrement object reference count of format/scan storage */ if (--fss->objRefCount <= 0) { #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* don't remove it right now (may be reusable), just add to GC */ ClockFmtScnStorageGC_In(fss); #else |
︙ | ︙ | |||
828 829 830 831 832 833 834 | ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; /* initialize hash table */ Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, &ClockFmtScnStorageHashKeyType); initialized = 1; | < | 831 832 833 834 835 836 837 838 839 840 841 842 843 844 | ClockFmtScnStorageHashKeyType.freeEntryProc = ClockFmtScnStorageFreeProc; /* initialize hash table */ Tcl_InitCustomHashTable(&FmtScnHashTable, TCL_CUSTOM_TYPE_KEYS, &ClockFmtScnStorageHashKeyType); initialized = 1; } /* get or create entry (and alocate storage) */ hPtr = Tcl_CreateHashEntry(&FmtScnHashTable, strFmt, &isNew); if (hPtr != NULL) { fss = FmtScn4HashEntry(hPtr); |
︙ | ︙ | |||
1015 1016 1017 1018 1019 1020 1021 | *---------------------------------------------------------------------- */ static const char * FindTokenBegin( const char *p, const char *end, | | > > > > > > | | > | < < > > > > > > > | > | 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 | *---------------------------------------------------------------------- */ static const char * FindTokenBegin( const char *p, const char *end, ClockScanToken *tok, int flags) { if (p < end) { char c; /* next token a known token type */ switch (tok->map->type) { case CTOKT_INT: case CTOKT_WIDE: if (!(flags & CLF_STRICT)) { /* should match at least one digit or space */ while (!isdigit(UCHAR(*p)) && !isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} } else { /* should match at least one digit */ while (!isdigit(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} } return p; case CTOKT_WORD: c = *(tok->tokWord.start); goto findChar; case CTOKT_SPACE: while (!isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} return p; case CTOKT_CHAR: c = *((char *)tok->map->data); findChar: if (!(flags & CLF_STRICT)) { /* should match the char or space */ while (*p != c && !isspace(UCHAR(*p)) && (p = Tcl_UtfNext(p)) < end) {} } else { /* should match the char */ while (*p != c && (p = Tcl_UtfNext(p)) < end) {} } return p; } } return p; } /* |
︙ | ︙ | |||
1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 | * None. * *---------------------------------------------------------------------- */ static void DetermineGreedySearchLen( DateInfo *info, ClockScanToken *tok, int *minLenPtr, int *maxLenPtr) { int minLen = tok->map->minSize; int maxLen; const char *p = yyInput + minLen; const char *end = info->dateEnd; /* if still tokens available, try to correct minimum length */ if ((tok + 1)->map) { end -= tok->endDistance + yySpaceCount; /* find position of next known token */ | > | > | 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 | * None. * *---------------------------------------------------------------------- */ static void DetermineGreedySearchLen( ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok, int *minLenPtr, int *maxLenPtr) { int minLen = tok->map->minSize; int maxLen; const char *p = yyInput + minLen; const char *end = info->dateEnd; /* if still tokens available, try to correct minimum length */ if ((tok + 1)->map) { end -= tok->endDistance + yySpaceCount; /* find position of next known token */ p = FindTokenBegin(p, end, tok + 1, TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT); if (p < end) { minLen = p - yyInput; } } /* max length to the end regarding distance to end (min-width of following tokens) */ maxLen = end - yyInput; |
︙ | ︙ | |||
1130 1131 1132 1133 1134 1135 1136 | end = info->dateEnd; } p += tok->lookAhMin; if (laTok->map && p < end) { /* try to find laTok between [lookAhMin, lookAhMax] */ while (minLen < maxLen) { | | > | 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 | end = info->dateEnd; } p += tok->lookAhMin; if (laTok->map && p < end) { /* try to find laTok between [lookAhMin, lookAhMax] */ while (minLen < maxLen) { const char *f = FindTokenBegin(p, end, laTok, TCL_CLOCK_FULL_COMPAT ? opts->flags : CLF_STRICT); /* if found (not below lookAhMax) */ if (f < end) { break; } /* try again with fewer length */ maxLen--; p--; |
︙ | ︙ | |||
1514 1515 1516 1517 1518 1519 1520 | #else static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; int ret, val; int minLen, maxLen; TclStrIdxTree *idxTree; | | | 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 | #else static int monthsKeys[] = {MCLIT_MONTHS_FULL, MCLIT_MONTHS_ABBREV, 0}; int ret, val; int minLen, maxLen; TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); /* get or create tree in msgcat dict */ idxTree = ClockMCGetMultiListIdxTree(opts, MCLIT_MONTHS_COMB, monthsKeys); if (idxTree == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1546 1547 1548 1549 1550 1551 1552 | static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0}; int ret, val; int minLen, maxLen; char curTok = *tok->tokWord.start; TclStrIdxTree *idxTree; | | | 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 | static int dowKeys[] = {MCLIT_DAYS_OF_WEEK_ABBREV, MCLIT_DAYS_OF_WEEK_FULL, 0}; int ret, val; int minLen, maxLen; char curTok = *tok->tokWord.start; TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); /* %u %w %Ou %Ow */ if (curTok != 'a' && curTok != 'A' && ((minLen <= 1 && maxLen >= 1) || PTR2INT(tok->map->data))) { val = -1; if (PTR2INT(tok->map->data) == 0) { |
︙ | ︙ | |||
1617 1618 1619 1620 1621 1622 1623 | DateInfo *info, ClockScanToken *tok) { int ret, val; int minLen, maxLen; Tcl_Obj *amPmObj[2]; | | | 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 | DateInfo *info, ClockScanToken *tok) { int ret, val; int minLen, maxLen; Tcl_Obj *amPmObj[2]; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); amPmObj[0] = ClockMCGet(opts, MCLIT_AM); amPmObj[1] = ClockMCGet(opts, MCLIT_PM); if (amPmObj[0] == NULL || amPmObj[1] == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1652 1653 1654 1655 1656 1657 1658 | { ClockClientData *dataPtr = opts->dataPtr; int ret, val; int minLen, maxLen; Tcl_Obj *eraObj[6]; | | | 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 | { ClockClientData *dataPtr = opts->dataPtr; int ret, val; int minLen, maxLen; Tcl_Obj *eraObj[6]; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); eraObj[0] = ClockMCGet(opts, MCLIT_BCE); eraObj[1] = ClockMCGet(opts, MCLIT_CE); eraObj[2] = dataPtr->mcLiterals[MCLIT_BCE2]; eraObj[3] = dataPtr->mcLiterals[MCLIT_CE2]; eraObj[4] = dataPtr->mcLiterals[MCLIT_BCE3]; eraObj[5] = dataPtr->mcLiterals[MCLIT_CE3]; |
︙ | ︙ | |||
1689 1690 1691 1692 1693 1694 1695 | DateInfo *info, ClockScanToken *tok) { int ret, val; int minLen, maxLen; TclStrIdxTree *idxTree; | | | 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 1720 1721 | DateInfo *info, ClockScanToken *tok) { int ret, val; int minLen, maxLen; TclStrIdxTree *idxTree; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); /* get or create tree in msgcat dict */ idxTree = ClockMCGetListIdxTree(opts, PTR2INT(tok->map->data) /* mcKey */); if (idxTree == NULL) { return TCL_ERROR; } |
︙ | ︙ | |||
1712 1713 1714 1715 1716 1717 1718 | } return TCL_OK; } static int ClockScnToken_JDN_Proc( | | | | 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 | } return TCL_OK; } static int ClockScnToken_JDN_Proc( ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int minLen, maxLen; const char *p = yyInput, *end, *s; Tcl_WideInt intJD; int fractJD = 0, fractJDDiv = 1; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); end = yyInput + maxLen; /* currently positive astronomic dates only */ if (*p == '+' || *p == '-') { p++; } |
︙ | ︙ | |||
1792 1793 1794 1795 1796 1797 1798 | ClockScanToken *tok) { int minLen, maxLen; int len = 0; const char *p = yyInput; Tcl_Obj *tzObjStor = NULL; | | | 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 | ClockScanToken *tok) { int minLen, maxLen; int len = 0; const char *p = yyInput; Tcl_Obj *tzObjStor = NULL; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); /* numeric timezone */ if (*p == '+' || *p == '-') { /* max chars in numeric zone = "+00:00:00" */ #define MAX_ZONE_LEN 9 char buf[MAX_ZONE_LEN + 1]; char *bp = buf; |
︙ | ︙ | |||
1875 1876 1877 1878 1879 1880 1881 | yyInput += len; return TCL_OK; } static int ClockScnToken_StarDate_Proc( | | | | 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 | yyInput += len; return TCL_OK; } static int ClockScnToken_StarDate_Proc( ClockFmtScnCmdArgs *opts, DateInfo *info, ClockScanToken *tok) { int minLen, maxLen; const char *p = yyInput, *end, *s; int year, fractYear, fractDayDiv, fractDay; static const char *stardatePref = "stardate "; DetermineGreedySearchLen(opts, info, tok, &minLen, &maxLen); end = yyInput + maxLen; /* stardate string */ p = TclUtfFindEqualNCInLwr(p, end, stardatePref, stardatePref + 9, &s); if (p >= end || p - yyInput < 9) { return TCL_RETURN; |
︙ | ︙ | |||
2432 2433 2434 2435 2436 2437 2438 | yyInput = ++p; } else if (*p == '-') { yyInput = ++p; sign = -1; } } | | | 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 | yyInput = ++p; } else if (*p == '-') { yyInput = ++p; sign = -1; } } DetermineGreedySearchLen(opts, info, tok, &minLen, &size); if (size < map->minSize) { /* missing input -> error */ if ((map->flags & CLF_OPTIONAL)) { continue; } goto not_match; |
︙ | ︙ | |||
3537 3538 3539 3540 3541 3542 3543 | ClockFrmScnClearCaches(void) { Tcl_MutexLock(&ClockFmtMutex); /* clear caches ... */ Tcl_MutexUnlock(&ClockFmtMutex); } | | | < > > > < > | 3555 3556 3557 3558 3559 3560 3561 3562 3563 3564 3565 3566 3567 3568 3569 3570 3571 3572 3573 3574 3575 3576 3577 3578 3579 3580 3581 3582 3583 3584 3585 3586 3587 3588 | ClockFrmScnClearCaches(void) { Tcl_MutexLock(&ClockFmtMutex); /* clear caches ... */ Tcl_MutexUnlock(&ClockFmtMutex); } void ClockFrmScnFinalize() { if (!initialized) { return; } Tcl_MutexLock(&ClockFmtMutex); #if CLOCK_FMT_SCN_STORAGE_GC_SIZE > 0 /* clear GC */ ClockFmtScnStorage_GC.stackPtr = NULL; ClockFmtScnStorage_GC.stackBound = NULL; ClockFmtScnStorage_GC.count = 0; #endif if (initialized) { initialized = 0; Tcl_DeleteHashTable(&FmtScnHashTable); } Tcl_MutexUnlock(&ClockFmtMutex); Tcl_MutexFinalize(&ClockFmtMutex); } /* * Local Variables: * mode: c * c-basic-offset: 4 * fill-column: 78 * End: */ |
Changes to generic/tclDate.h.
︙ | ︙ | |||
556 557 558 559 560 561 562 563 564 | Tcl_Obj *objPtr); MODULE_SCOPE Tcl_Obj * ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); MODULE_SCOPE int ClockScan(DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); MODULE_SCOPE int ClockFormat(DateFormat *dateFmt, ClockFmtScnCmdArgs *opts); MODULE_SCOPE void ClockFrmScnClearCaches(void); #endif /* _TCLCLOCK_H */ | > | 556 557 558 559 560 561 562 563 564 565 | Tcl_Obj *objPtr); MODULE_SCOPE Tcl_Obj * ClockLocalizeFormat(ClockFmtScnCmdArgs *opts); MODULE_SCOPE int ClockScan(DateInfo *info, Tcl_Obj *strObj, ClockFmtScnCmdArgs *opts); MODULE_SCOPE int ClockFormat(DateFormat *dateFmt, ClockFmtScnCmdArgs *opts); MODULE_SCOPE void ClockFrmScnClearCaches(void); MODULE_SCOPE void ClockFrmScnFinalize(); #endif /* _TCLCLOCK_H */ |
Changes to generic/tclDecls.h.
︙ | ︙ | |||
423 424 425 426 427 428 429 | /* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* Slot 147 is reserved */ | | < < < < < | | | 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 | /* Slot 144 is reserved */ /* 145 */ EXTERN Tcl_HashEntry * Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 146 */ EXTERN int Tcl_Flush(Tcl_Channel chan); /* Slot 147 is reserved */ /* Slot 148 is reserved */ /* 149 */ EXTERN int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 150 */ EXTERN void * Tcl_GetAssocData(Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 151 */ EXTERN Tcl_Channel Tcl_GetChannel(Tcl_Interp *interp, const char *chanName, int *modePtr); |
︙ | ︙ | |||
757 758 759 760 761 762 763 | /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); | | > > > > > | 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 | /* 282 */ EXTERN int Tcl_UnstackChannel(Tcl_Interp *interp, Tcl_Channel chan); /* 283 */ EXTERN Tcl_Channel Tcl_GetStackedChannel(Tcl_Channel chan); /* 284 */ EXTERN void Tcl_SetMainLoop(Tcl_MainLoopProc *proc); /* 285 */ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 286 */ EXTERN void Tcl_AppendObjToObj(Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 287 */ EXTERN Tcl_Encoding Tcl_CreateEncoding(const Tcl_EncodingType *typePtr); /* 288 */ EXTERN void Tcl_CreateThreadExitHandler(Tcl_ExitProc *proc, |
︙ | ︙ | |||
1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 | EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); /* 686 */ EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 687 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n); /* 688 */ EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; | > > > > > | 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 | EXTERN Tcl_Obj * Tcl_DStringToObj(Tcl_DString *dsPtr); /* 686 */ EXTERN int Tcl_UtfNcmp(const char *s1, const char *s2, size_t n); /* 687 */ EXTERN int Tcl_UtfNcasecmp(const char *s1, const char *s2, size_t n); /* 688 */ EXTERN Tcl_Obj * Tcl_NewWideUIntObj(Tcl_WideUInt wideValue); /* 689 */ EXTERN void Tcl_SetWideUIntObj(Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 690 */ EXTERN void TclUnusedStubEntry(void); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; } TclStubHooks; |
︙ | ︙ | |||
2023 2024 2025 2026 2027 2028 2029 | int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*reserved147)(void); | | | | 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 2043 | int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */ int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */ void (*tcl_Finalize) (void); /* 143 */ void (*reserved144)(void); Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*reserved147)(void); void (*reserved148)(void); int (*tclGetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 149 */ void * (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ Tcl_Size (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, void **handlePtr); /* 153 */ void * (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ |
︙ | ︙ | |||
2160 2161 2162 2163 2164 2165 2166 | void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ | | | 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 | void (*reserved278)(void); void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */ void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */ Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, void *instanceData, int mask, Tcl_Channel prevChan); /* 281 */ int (*tcl_UnstackChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 282 */ Tcl_Channel (*tcl_GetStackedChannel) (Tcl_Channel chan); /* 283 */ void (*tcl_SetMainLoop) (Tcl_MainLoopProc *proc); /* 284 */ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr); /* 285 */ void (*tcl_AppendObjToObj) (Tcl_Obj *objPtr, Tcl_Obj *appendObjPtr); /* 286 */ Tcl_Encoding (*tcl_CreateEncoding) (const Tcl_EncodingType *typePtr); /* 287 */ void (*tcl_CreateThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 288 */ void (*tcl_DeleteThreadExitHandler) (Tcl_ExitProc *proc, void *clientData); /* 289 */ void (*reserved290)(void); int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, Tcl_Size numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int flags); /* 292 */ |
︙ | ︙ | |||
2563 2564 2565 2566 2567 2568 2569 | int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */ int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ | > > | | 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 | int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, Tcl_Size numBytes, void **clientDataPtr, int *typePtr); /* 681 */ int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */ Tcl_Size (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */ int (*tcl_GetWideUIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_WideUInt *uwidePtr); /* 684 */ Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 685 */ int (*tcl_UtfNcmp) (const char *s1, const char *s2, size_t n); /* 686 */ int (*tcl_UtfNcasecmp) (const char *s1, const char *s2, size_t n); /* 687 */ Tcl_Obj * (*tcl_NewWideUIntObj) (Tcl_WideUInt wideValue); /* 688 */ void (*tcl_SetWideUIntObj) (Tcl_Obj *objPtr, Tcl_WideUInt uwideValue); /* 689 */ void (*tclUnusedStubEntry) (void); /* 690 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus } #endif |
︙ | ︙ | |||
2856 2857 2858 2859 2860 2861 2862 | (tclStubsPtr->tcl_Finalize) /* 143 */ /* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ /* Slot 147 is reserved */ | < | | | | 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 | (tclStubsPtr->tcl_Finalize) /* 143 */ /* Slot 144 is reserved */ #define Tcl_FirstHashEntry \ (tclStubsPtr->tcl_FirstHashEntry) /* 145 */ #define Tcl_Flush \ (tclStubsPtr->tcl_Flush) /* 146 */ /* Slot 147 is reserved */ /* Slot 148 is reserved */ #define TclGetAliasObj \ (tclStubsPtr->tclGetAliasObj) /* 149 */ #define Tcl_GetAssocData \ (tclStubsPtr->tcl_GetAssocData) /* 150 */ #define Tcl_GetChannel \ (tclStubsPtr->tcl_GetChannel) /* 151 */ #define Tcl_GetChannelBufferSize \ (tclStubsPtr->tcl_GetChannelBufferSize) /* 152 */ #define Tcl_GetChannelHandle \ |
︙ | ︙ | |||
3104 3105 3106 3107 3108 3109 3110 | (tclStubsPtr->tcl_StackChannel) /* 281 */ #define Tcl_UnstackChannel \ (tclStubsPtr->tcl_UnstackChannel) /* 282 */ #define Tcl_GetStackedChannel \ (tclStubsPtr->tcl_GetStackedChannel) /* 283 */ #define Tcl_SetMainLoop \ (tclStubsPtr->tcl_SetMainLoop) /* 284 */ | > | | 3110 3111 3112 3113 3114 3115 3116 3117 3118 3119 3120 3121 3122 3123 3124 3125 | (tclStubsPtr->tcl_StackChannel) /* 281 */ #define Tcl_UnstackChannel \ (tclStubsPtr->tcl_UnstackChannel) /* 282 */ #define Tcl_GetStackedChannel \ (tclStubsPtr->tcl_GetStackedChannel) /* 283 */ #define Tcl_SetMainLoop \ (tclStubsPtr->tcl_SetMainLoop) /* 284 */ #define Tcl_GetAliasObj \ (tclStubsPtr->tcl_GetAliasObj) /* 285 */ #define Tcl_AppendObjToObj \ (tclStubsPtr->tcl_AppendObjToObj) /* 286 */ #define Tcl_CreateEncoding \ (tclStubsPtr->tcl_CreateEncoding) /* 287 */ #define Tcl_CreateThreadExitHandler \ (tclStubsPtr->tcl_CreateThreadExitHandler) /* 288 */ #define Tcl_DeleteThreadExitHandler \ |
︙ | ︙ | |||
3891 3892 3893 3894 3895 3896 3897 3898 | (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ #define Tcl_UtfNcmp \ (tclStubsPtr->tcl_UtfNcmp) /* 686 */ #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 687 */ #define TclUnusedStubEntry \ | > > > > | | 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 | (tclStubsPtr->tcl_GetWideUIntFromObj) /* 684 */ #define Tcl_DStringToObj \ (tclStubsPtr->tcl_DStringToObj) /* 685 */ #define Tcl_UtfNcmp \ (tclStubsPtr->tcl_UtfNcmp) /* 686 */ #define Tcl_UtfNcasecmp \ (tclStubsPtr->tcl_UtfNcasecmp) /* 687 */ #define Tcl_NewWideUIntObj \ (tclStubsPtr->tcl_NewWideUIntObj) /* 688 */ #define Tcl_SetWideUIntObj \ (tclStubsPtr->tcl_SetWideUIntObj) /* 689 */ #define TclUnusedStubEntry \ (tclStubsPtr->tclUnusedStubEntry) /* 690 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ #undef TclUnusedStubEntry |
︙ | ︙ | |||
4154 4155 4156 4157 4158 4159 4160 | #undef TclUtfPrev #ifndef TCL_NO_DEPRECATED # define Tcl_CreateSlave Tcl_CreateChild # define Tcl_GetSlave Tcl_GetChild # define Tcl_GetMaster Tcl_GetParent #endif | | > | 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 | #undef TclUtfPrev #ifndef TCL_NO_DEPRECATED # define Tcl_CreateSlave Tcl_CreateChild # define Tcl_GetSlave Tcl_GetChild # define Tcl_GetMaster Tcl_GetParent #endif /* Protect those 11 functions, make them useless through the stub table */ #undef TclGetStringFromObj #undef TclGetBytesFromObj #undef TclGetUnicodeFromObj #undef TclListObjGetElements #undef TclListObjLength #undef TclDictObjSize #undef TclSplitList #undef TclSplitPath #undef TclFSSplitPath #undef TclParseArgsObjv #undef TclGetAliasObj #if TCL_MAJOR_VERSION < 9 /* TIP #627 for 8.7 */ # undef Tcl_CreateObjCommand2 # define Tcl_CreateObjCommand2 Tcl_CreateObjCommand # undef Tcl_CreateObjTrace2 # define Tcl_CreateObjTrace2 Tcl_CreateObjTrace |
︙ | ︙ | |||
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 | tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) \ tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) #elif defined(TCL_8_API) # undef Tcl_GetByteArrayFromObj # undef Tcl_GetBytesFromObj # undef Tcl_GetStringFromObj # undef Tcl_GetUnicodeFromObj # undef Tcl_ListObjGetElements # undef Tcl_ListObjLength # undef Tcl_DictObjSize # undef Tcl_SplitList # undef Tcl_SplitPath # undef Tcl_FSSplitPath # undef Tcl_ParseArgsObjv # if !defined(USE_TCL_STUBS) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ (Tcl_GetBytesFromObj)(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ (Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) | > > > > | 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 | tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) # undef Tcl_FSSplitPath # define Tcl_FSSplitPath(pathPtr, lenPtr) \ tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) # undef Tcl_ParseArgsObjv # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) # undef Tcl_GetAliasObj # define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) \ tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) #elif defined(TCL_8_API) # undef Tcl_GetByteArrayFromObj # undef Tcl_GetBytesFromObj # undef Tcl_GetStringFromObj # undef Tcl_GetUnicodeFromObj # undef Tcl_ListObjGetElements # undef Tcl_ListObjLength # undef Tcl_DictObjSize # undef Tcl_SplitList # undef Tcl_SplitPath # undef Tcl_FSSplitPath # undef Tcl_ParseArgsObjv # undef Tcl_GetAliasObj # if !defined(USE_TCL_STUBS) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ (Tcl_GetBytesFromObj)(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ TclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ (Tcl_GetBytesFromObj)((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) |
︙ | ︙ | |||
4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 | (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ TclFSSplitPath((pathPtr), (lenPtr)) : \ (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # elif !defined(BUILD_tcl) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) | > > > | 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 | (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ TclFSSplitPath((pathPtr), (lenPtr)) : \ (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ TclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \ (Tcl_GetAliasObj)((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv))) # elif !defined(BUILD_tcl) # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj(NULL, (objPtr), (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (Tcl_Size *)(void *)(sizePtr))) # define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) (sizeof(*(sizePtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetBytesFromObj((interp), (objPtr), (sizePtr)) : \ tclStubsPtr->tcl_GetBytesFromObj((interp), (objPtr), (Tcl_Size *)(void *)(sizePtr))) |
︙ | ︙ | |||
4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 | tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) : \ tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # endif /* defined(USE_TCL_STUBS) */ #else /* !defined(TCL_8_API) */ # undef Tcl_GetByteArrayFromObj # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) #endif /* defined(TCL_8_API) */ #endif /* _TCLDECLS */ | > > > | 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 4324 4325 4326 | tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr))) # define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) <= sizeof(int) ? \ tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) : \ tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr))) # define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) : \ tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv))) # define Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, objcPtr, objv) (sizeof(*(objcPtr)) <= sizeof(int) ? \ tclStubsPtr->tclGetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (objcPtr), (objv)) : \ tclStubsPtr->tcl_GetAliasObj((interp), (childCmd), (targetInterpPtr), (targetCmdPtr), (Tcl_Size *)(void *)(objcPtr), (objv))) # endif /* defined(USE_TCL_STUBS) */ #else /* !defined(TCL_8_API) */ # undef Tcl_GetByteArrayFromObj # define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \ Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr)) #endif /* defined(TCL_8_API) */ #endif /* _TCLDECLS */ |
Changes to generic/tclIO.c.
︙ | ︙ | |||
101 102 103 104 105 106 107 | int writeFlags; /* Original write channel flags. */ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ Tcl_WideInt total; /* Total bytes transferred (written). */ Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | int writeFlags; /* Original write channel flags. */ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ Tcl_WideInt total; /* Total bytes transferred (written). */ Tcl_Interp *interp; /* Interp that started the copy. */ Tcl_Obj *cmdPtr; /* Command to be invoked at completion. */ Tcl_Size bufSize; /* Size of appended buffer. */ char buffer[TCLFLEXARRAY]; /* Copy buffer, this must be the last * field. */ } CopyState; /* * All static variables used in this file are collected into a single instance * of the following structure. For multi-threaded implementations, there is * one instance of this structure for each thread. * |
︙ | ︙ | |||
226 227 228 229 230 231 232 | const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static Tcl_Size Write(Channel *chanPtr, const char *src, Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); | | | 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 | const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); static Tcl_Size Write(Channel *chanPtr, const char *src, Tcl_Size srcLen, Tcl_Encoding encoding); static Tcl_Obj * FixLevelCode(Tcl_Obj *msg); static void SpliceChannel(Tcl_Channel chan); static void CutChannel(Tcl_Channel chan); static int WillRead(Channel *chanPtr); #define WriteChars(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, chanPtr->state->encoding) #define WriteBytes(chanPtr, src, srcLen) \ Write(chanPtr, src, srcLen, tclIdentityEncoding) /* |
︙ | ︙ | |||
427 428 429 430 431 432 433 | /* * Each read op must set the blocked and eof states anew, not let * the effect of prior reads leak through. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { | | | | | 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 | /* * Each read op must set the blocked and eof states anew, not let * the effect of prior reads leak through. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (WillRead(chanPtr) == -1) { return -1; } bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData, dst, dstSize, &result); /* * Stop any flag leakage through stacked channel levels. */ if (GotFlag(chanPtr->state, CHANNEL_EOF)) { chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START; } ResetFlag(chanPtr->state, CHANNEL_BLOCKED | CHANNEL_EOF); chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END; if (bytesRead == -1) { if ((result == EWOULDBLOCK) || (result == EAGAIN)) { SetFlag(chanPtr->state, CHANNEL_BLOCKED); result = EAGAIN; |
︙ | ︙ | |||
584 585 586 587 588 589 590 | int doflushnb; /* * Fetch the pre-TIP#398 compatibility flag. */ { | | | | | | | | | | | | | | | | | | | | | | | | 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 | int doflushnb; /* * Fetch the pre-TIP#398 compatibility flag. */ { const char *s; Tcl_DString ds; s = TclGetEnv("TCL_FLUSH_NONBLOCKING_ON_EXIT", &ds); doflushnb = ((s != NULL) && strcmp(s, "0")); if (s != NULL) { Tcl_DStringFree(&ds); } } /* * Walk all channel state structures known to this thread and close * corresponding channels. */ while (active) { /* * Iterate through the open channel list, and find the first channel * that isn't dead. We start from the head of the list each time, * because the close action on one channel can close others. */ active = 0; for (statePtr = tsdPtr->firstCSPtr; statePtr != NULL; statePtr = statePtr->nextCSPtr) { chanPtr = statePtr->topChanPtr; if (GotFlag(statePtr, CHANNEL_DEAD)) { continue; } if (!GotFlag(statePtr, CHANNEL_INCLOSE | CHANNEL_CLOSED ) || GotFlag(statePtr, BG_FLUSH_SCHEDULED)) { ResetFlag(statePtr, BG_FLUSH_SCHEDULED); active = 1; break; } } /* * We've found a live (or bg-closing) channel. Close it. */ if (active) { TclChannelPreserve((Tcl_Channel)chanPtr); /* * TIP #398: by default, we no longer set the channel back into * blocking mode. To restore the old blocking behavior, the * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set * and not be "0". */ if (doflushnb) { /* * Set the channel back into blocking mode to ensure that we * wait for all data to flush out. */ (void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr, "-blocking", "on"); } if ((chanPtr == (Channel *) tsdPtr->stdinChannel) || (chanPtr == (Channel *) tsdPtr->stdoutChannel) || (chanPtr == (Channel *) tsdPtr->stderrChannel)) { /* * Decrement the refcount which was earlier artificially * bumped up to keep the channel from being closed. |
︙ | ︙ | |||
1234 1235 1236 1237 1238 1239 1240 | ChannelState *statePtr; /* State of the real channel. */ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 | ChannelState *statePtr; /* State of the real channel. */ statePtr = ((Channel *) chan)->state->bottomChanPtr->state; if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } if (DetachChannel(interp, chan) != TCL_OK) { return TCL_OK; } |
︙ | ︙ | |||
1462 1463 1464 1465 1466 1467 1468 | } } hTblPtr = GetChannelTable(interp); hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 | } } hTblPtr = GetChannelTable(interp); hPtr = Tcl_FindHashEntry(hTblPtr, name); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can not find channel named \"%s\"", chanName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanName, (char *)NULL); return NULL; } /* * Always return bottom-most channel in the stack. This one lives the * longest - other channels may go away unnoticed. The other APIs |
︙ | ︙ | |||
1550 1551 1552 1553 1554 1555 1556 | if (resPtr) { Tcl_StoreInternalRep(objPtr, &chanObjType, NULL); } return TCL_ERROR; } if (resPtr && resPtr->refCount == 1) { | < | < < > | 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 | if (resPtr) { Tcl_StoreInternalRep(objPtr, &chanObjType, NULL); } return TCL_ERROR; } if (resPtr && resPtr->refCount == 1) { /* Re-use the ResolvedCmdName struct */ Tcl_Release(resPtr->statePtr); } else { resPtr = (ResolvedChanName *) Tcl_Alloc(sizeof(ResolvedChanName)); resPtr->refCount = 0; ChanSetInternalRep(objPtr, resPtr); /* Overwrites, if needed */ } statePtr = ((Channel *)chan)->state; resPtr->statePtr = statePtr; |
︙ | ︙ | |||
1647 1648 1649 1650 1651 1652 1653 | * information for the channel. */ if (chanName != NULL) { unsigned len = strlen(chanName) + 1; /* | | | | | 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 | * information for the channel. */ if (chanName != NULL) { unsigned len = strlen(chanName) + 1; /* * Make sure we allocate at least 7 bytes, so it fits for "stdout" * later. */ tmp = (char *)Tcl_Alloc((len < 7) ? 7 : len); strcpy(tmp, chanName); } else { tmp = (char *)Tcl_Alloc(7); tmp[0] = '\0'; } |
︙ | ︙ | |||
1833 1834 1835 1836 1837 1838 1839 | while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) { statePtr = statePtr->nextCSPtr; } if (statePtr == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 1831 1832 1833 1834 1835 1836 1837 1838 1839 1840 1841 1842 1843 1844 1845 | while ((statePtr != NULL) && (statePtr->topChanPtr != prevChanPtr)) { statePtr = statePtr->nextCSPtr; } if (statePtr == NULL) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't find state for channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } /* * Here we check if the given "mask" matches the "flags" of the already |
︙ | ︙ | |||
1884 1885 1886 1887 1888 1889 1890 | * the stacking state of this channel during its operations. */ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 | * the stacking state of this channel during its operations. */ if (Tcl_Flush((Tcl_Channel) prevChanPtr) != TCL_OK) { statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName(prevChan))); } return NULL; } statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; |
︙ | ︙ | |||
2079 2080 2081 2082 2083 2084 2085 | * bypass area into the regular interpreter result. Fall back * to the regular message if nothing was found in the * bypasses. */ if (!TclChanCaughtErrorBypass(interp, chan) && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2091 | * bypass area into the regular interpreter result. Fall back * to the regular message if nothing was found in the * bypasses. */ if (!TclChanCaughtErrorBypass(interp, chan) && interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "could not flush channel \"%s\"", Tcl_GetChannelName((Tcl_Channel) chanPtr))); } return TCL_ERROR; } statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; |
︙ | ︙ | |||
2412 2413 2414 2415 2416 2417 2418 | { Channel *chanPtr; /* The actual channel. */ void *handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { | | | | | 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 | { Channel *chanPtr; /* The actual channel. */ void *handle; int result; chanPtr = ((Channel *) chan)->state->bottomChanPtr; if (!chanPtr->typePtr->getHandleProc) { Tcl_SetChannelError(chan, Tcl_ObjPrintf( "channel \"%s\" does not support OS handles", Tcl_GetChannelName(chan))); return TCL_ERROR; } result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction, &handle); if (handlePtr) { *handlePtr = handle; } |
︙ | ︙ | |||
2444 2445 2446 2447 2448 2449 2450 | * May leave an error message in the interp. * *---------------------------------------------------------------------- */ int Tcl_RemoveChannelMode( | | | | | 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 | * May leave an error message in the interp. * *---------------------------------------------------------------------- */ int Tcl_RemoveChannelMode( Tcl_Interp *interp, /* The interp for an error message. Allowed to be NULL. */ Tcl_Channel chan, /* The channel which is modified. */ int mode) /* The access mode to drop from the channel */ { const char* emsg; ChannelState *statePtr = ((Channel *) chan)->state; /* State of actual channel. */ if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { emsg = "Illegal mode value."; goto error; } if (0 == (GotFlag(statePtr, TCL_READABLE|TCL_WRITABLE) & ~mode)) { emsg = "Bad mode, would make channel inacessible"; goto error; } ResetFlag(statePtr, mode); return TCL_OK; error: |
︙ | ︙ | |||
2695 2696 2697 2698 2699 2700 2701 | if (!GotFlag(statePtr, CHANNEL_DEAD)) { return 0; } Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 | if (!GotFlag(statePtr, CHANNEL_DEAD)) { return 0; } Tcl_SetErrno(EINVAL); if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to access channel: invalid channel", -1)); } return 1; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
3006 3007 3008 3009 3010 3011 3012 | */ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, | | | 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017 3018 | */ if (GotFlag(statePtr, CHANNEL_CLOSEDWRITE) && (statePtr->outQueueHead == NULL) && ((statePtr->curOutPtr == NULL) || IsBufferEmpty(statePtr->curOutPtr))) { errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE); goto done; } done: TclChannelRelease((Tcl_Channel)chanPtr); return errorCode; } |
︙ | ︙ | |||
3150 3151 3152 3153 3154 3155 3156 | Tcl_SetErrno(errorCode); } } /* * Cancel any outstanding timer. */ | < > | 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 | Tcl_SetErrno(errorCode); } } /* * Cancel any outstanding timer. */ DeleteTimerHandler(statePtr); /* * Mark the channel as deleted by clearing the type structure. */ if (chanPtr->downChanPtr != NULL) { Channel *downChanPtr = chanPtr->downChanPtr; |
︙ | ︙ | |||
3455 3456 3457 3458 3459 3460 3461 | if (statePtr->refCount > 0) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 3453 3454 3455 3456 3457 3458 3459 3460 3461 3462 3463 3464 3465 3466 3467 3468 | if (statePtr->refCount > 0) { Tcl_Panic("called Tcl_Close on channel with refCount > 0"); } if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } SetFlag(statePtr, CHANNEL_INCLOSE); /* * When the channel has an escape sequence driven encoding such as |
︙ | ︙ | |||
3669 3670 3671 3672 3673 3674 3675 | if (flags & TCL_CLOSE_READ) { msg = "read"; } else { msg = "write"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | | | | 3667 3668 3669 3670 3671 3672 3673 3674 3675 3676 3677 3678 3679 3680 3681 3682 3683 3684 3685 3686 3687 3688 3689 3690 3691 3692 3693 3694 3695 | if (flags & TCL_CLOSE_READ) { msg = "read"; } else { msg = "write"; } Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Half-close of %s-side not possible, side not opened or" " already closed", msg)); return TCL_ERROR; } /* * A user may try to call half-close from within a channel close handler. * That won't do. */ if (GotFlag(statePtr, CHANNEL_INCLOSE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "illegal recursive call to close through close-handler" " of channel", -1)); } return TCL_ERROR; } if (flags & TCL_CLOSE_READ) { /* * Call the finalization code directly. There are no events to handle, |
︙ | ︙ | |||
3744 3745 3746 3747 3748 3749 3750 | *---------------------------------------------------------------------- */ static int CloseWrite( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr) /* The channel whose write side is being | | | | | 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 3755 3756 3757 3758 3759 3760 3761 3762 3763 3764 3765 3766 3767 | *---------------------------------------------------------------------- */ static int CloseWrite( Tcl_Interp *interp, /* Interpreter for errors. */ Channel *chanPtr) /* The channel whose write side is being * closed. May still be used by some * interpreter */ { /* * Notes: clear-channel-handlers - write side only ? or keep around, just * not called. * * No close callbacks are run - channel is still open (read side) */ ChannelState *statePtr = chanPtr->state; /* State of real IO channel. */ int flushcode; int result = 0; /* * The call to FlushChannel will flush any queued output and invoke the * close function of the channel driver, or it will set up the channel to * be flushed and closed asynchronously. |
︙ | ︙ | |||
3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 3970 | chanPtr = (Channel *) channel; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; /* * Cancel any outstanding timer. */ DeleteTimerHandler(statePtr); /* * Remove any references to channel handlers for this channel that may be * about to be invoked. */ | > | 3955 3956 3957 3958 3959 3960 3961 3962 3963 3964 3965 3966 3967 3968 3969 | chanPtr = (Channel *) channel; statePtr = chanPtr->state; chanPtr = statePtr->topChanPtr; /* * Cancel any outstanding timer. */ DeleteTimerHandler(statePtr); /* * Remove any references to channel handlers for this channel that may be * about to be invoked. */ |
︙ | ︙ | |||
4328 4329 4330 4331 4332 4333 4334 | *---------------------------------------------------------------------- */ static Tcl_Size Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ | | | | 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 | *---------------------------------------------------------------------- */ static Tcl_Size Write( Channel *chanPtr, /* The channel to buffer output for. */ const char *src, /* UTF-8 string to write. */ Tcl_Size srcLen, /* Length of UTF-8 string in bytes. */ Tcl_Encoding encoding) { ChannelState *statePtr = chanPtr->state; /* State info for channel */ char *nextNewLine = NULL; int endEncoding, needNlFlush = 0; Tcl_Size saved = 0, total = 0, flushed = 0; char safe[BUFFER_PADDING]; int encodingError = 0; if (srcLen) { WillWrite(chanPtr); } /* * Write the terminated escape sequence even if srcLen is 0. */ endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0); |
︙ | ︙ | |||
4972 4973 4974 4975 4976 4977 4978 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: assert(!GotFlag(statePtr, CHANNEL_EOF) | | < | 4971 4972 4973 4974 4975 4976 4977 4978 4979 4980 4981 4982 4983 4984 4985 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ done: assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); /* * Regenerate the top channel, in case it was changed due to * self-modifying reflected transforms. |
︙ | ︙ | |||
5113 5114 5115 5116 5117 5118 5119 | } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. * Here the buffer is non-empty so we know we're a non-EOF. | | | 5111 5112 5113 5114 5115 5116 5117 5118 5119 5120 5121 5122 5123 5124 5125 | } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer. * Here the buffer is non-empty so we know we're a non-EOF. */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } dst = (unsigned char *) RemovePoint(bufPtr); dstEnd = dst + BytesLeft(bufPtr); |
︙ | ︙ | |||
5408 5409 5410 5411 5412 5413 5414 | } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, * a CHANNEL_EOF implies an empty buffer. Here the buffer is * non-empty so we know we're a non-EOF. | | | 5406 5407 5408 5409 5410 5411 5412 5413 5414 5415 5416 5417 5418 5419 5420 | } else { /* * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new * CHANNEL_STICKY_EOF set in this routine leads to return before * coming back here. When we are not dealing with CHANNEL_STICKY_EOF, * a CHANNEL_EOF implies an empty buffer. Here the buffer is * non-empty so we know we're a non-EOF. */ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF)); assert(!GotFlag(statePtr, CHANNEL_EOF)); } /* * Convert some of the bytes from the channel buffer to UTF-8. Space in |
︙ | ︙ | |||
5770 5771 5772 5773 5774 5775 5776 | memcpy(readBuf, RemovePoint(bufPtr), toCopy); bufPtr->nextRemoved += toCopy; copied += toCopy; readBuf += toCopy; bytesToRead -= toCopy; /* | | | | 5768 5769 5770 5771 5772 5773 5774 5775 5776 5777 5778 5779 5780 5781 5782 5783 | memcpy(readBuf, RemovePoint(bufPtr), toCopy); bufPtr->nextRemoved += toCopy; copied += toCopy; readBuf += toCopy; bytesToRead -= toCopy; /* * If the current buffer is empty recycle it. */ if (IsBufferEmpty(bufPtr)) { chanPtr->inQueueHead = bufPtr->nextPtr; if (chanPtr->inQueueHead == NULL) { chanPtr->inQueueTail = NULL; } RecycleBuffer(chanPtr->state, bufPtr, 0); |
︙ | ︙ | |||
5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 5950 | if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); return -1; } /* * Early out when next read will see eofchar. * * NOTE: See DoRead for argument that it's a bug (one we're keeping) to * have this escape before the one for zero-char read request. */ | > | 5935 5936 5937 5938 5939 5940 5941 5942 5943 5944 5945 5946 5947 5948 5949 | if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR); /* TODO: UpdateInterest not needed here? */ UpdateInterest(chanPtr); Tcl_SetErrno(EILSEQ); return -1; } /* * Early out when next read will see eofchar. * * NOTE: See DoRead for argument that it's a bug (one we're keeping) to * have this escape before the one for zero-char read request. */ |
︙ | ︙ | |||
6094 6095 6096 6097 6098 6099 6100 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ assert(!GotFlag(statePtr, CHANNEL_EOF) | | < | | 6093 6094 6095 6096 6097 6098 6099 6100 6101 6102 6103 6104 6105 6106 6107 6108 6109 6110 | /* * Update the notifier state so we don't block while there is still data * in the buffers. */ assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); /* This must comes after UpdateInterest(), which may set errno */ if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) && (!copied || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) { /* Channel either is blocking or is nonblocking with no data * succesfully red before the error. Return an error so that callers |
︙ | ︙ | |||
7050 7051 7052 7053 7054 7055 7056 | bufPtr = statePtr->saveInBufPtr; statePtr->saveInBufPtr = NULL; /* * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done to honor * dynamic changes of the buffersize made by the user. | | | 7048 7049 7050 7051 7052 7053 7054 7055 7056 7057 7058 7059 7060 7061 7062 | bufPtr = statePtr->saveInBufPtr; statePtr->saveInBufPtr = NULL; /* * Check the actual buffersize against the requested buffersize. * Saved buffers of the wrong size are squashed. This is done to honor * dynamic changes of the buffersize made by the user. * * TODO: Tests to cover this. */ if ((bufPtr != NULL) && (bufPtr->bufLength != statePtr->bufSize + BUFFER_PADDING)) { ReleaseChannelBuffer(bufPtr); bufPtr = NULL; |
︙ | ︙ | |||
7407 7408 7409 7410 7411 7412 7413 | * Seek first to force a total flush of all pending buffers and ditch any * preread input data. */ WillWrite(chanPtr); if (WillRead(chanPtr) == -1) { | | | 7405 7406 7407 7408 7409 7410 7411 7412 7413 7414 7415 7416 7417 7418 7419 | * Seek first to force a total flush of all pending buffers and ditch any * preread input data. */ WillWrite(chanPtr); if (WillRead(chanPtr) == -1) { return TCL_ERROR; } /* * We're all flushed to disk now and we also don't have any unfortunate * input baggage around either; can truncate with impunity. */ |
︙ | ︙ | |||
7540 7541 7542 7543 7544 7545 7546 | if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { return 0; } return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } | < | 7538 7539 7540 7541 7542 7543 7544 7545 7546 7547 7548 7549 7550 7551 | if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) { return 0; } return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0; } /* *---------------------------------------------------------------------- * * TclChannelGetBlockingMode -- * * Returns 1 if the channel is in blocking mode (default), 0 otherwise. * |
︙ | ︙ | |||
7566 7567 7568 7569 7570 7571 7572 | Tcl_Channel chan) { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; } | | | 7563 7564 7565 7566 7567 7568 7569 7570 7571 7572 7573 7574 7575 7576 7577 | Tcl_Channel chan) { ChannelState *statePtr = ((Channel *) chan)->state; /* State of real channel structure. */ return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1; } /* *---------------------------------------------------------------------- * * Tcl_InputBlocked -- * * Returns 1 if input is blocked on this channel, 0 otherwise. * |
︙ | ︙ | |||
7842 7843 7844 7845 7846 7847 7848 | { if (interp != NULL) { const char *genericopt = "blocking buffering buffersize encoding eofchar profile translation"; const char **argv; Tcl_Size argc, i; Tcl_DString ds; | | | | | 7839 7840 7841 7842 7843 7844 7845 7846 7847 7848 7849 7850 7851 7852 7853 7854 7855 7856 7857 7858 7859 7860 7861 7862 7863 7864 7865 7866 7867 7868 7869 7870 7871 7872 7873 | { if (interp != NULL) { const char *genericopt = "blocking buffering buffersize encoding eofchar profile translation"; const char **argv; Tcl_Size argc, i; Tcl_DString ds; Tcl_Obj *errObj; Tcl_DStringInit(&ds); Tcl_DStringAppend(&ds, genericopt, -1); if (optionList && (*optionList)) { TclDStringAppendLiteral(&ds, " "); Tcl_DStringAppend(&ds, optionList, -1); } if (Tcl_SplitList(interp, Tcl_DStringValue(&ds), &argc, &argv) != TCL_OK) { Tcl_Panic("malformed option list in channel driver"); } Tcl_ResetResult(interp); errObj = Tcl_ObjPrintf("bad option \"%s\": should be one of ", optionName ? optionName : ""); argc--; for (i = 0; i < argc; i++) { Tcl_AppendPrintfToObj(errObj, "-%s, ", argv[i]); } Tcl_AppendPrintfToObj(errObj, "or -%s", argv[i]); Tcl_SetObjResult(interp, errObj); Tcl_DStringFree(&ds); Tcl_Free((void *)argv); } Tcl_SetErrno(EINVAL); return TCL_ERROR; } |
︙ | ︙ | |||
8125 8126 8127 8128 8129 8130 8131 | /* * If the channel is in the middle of a background copy, fail. */ if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( | | | | 8122 8123 8124 8125 8126 8127 8128 8129 8130 8131 8132 8133 8134 8135 8136 8137 | /* * If the channel is in the middle of a background copy, fail. */ if (statePtr->csPtrR || statePtr->csPtrW) { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "unable to set channel options: background copy in" " progress", -1)); } return TCL_ERROR; } /* * Disallow options on dead channels -- channels that have been closed but * not yet been deallocated. Such channels can be found if the exit |
︙ | ︙ | |||
8175 8176 8177 8178 8179 8180 8181 | ResetFlag(statePtr, CHANNEL_UNBUFFERED); SetFlag(statePtr, CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { | | | | | | 8172 8173 8174 8175 8176 8177 8178 8179 8180 8181 8182 8183 8184 8185 8186 8187 8188 8189 | ResetFlag(statePtr, CHANNEL_UNBUFFERED); SetFlag(statePtr, CHANNEL_LINEBUFFERED); } else if ((newValue[0] == 'n') && (strncmp(newValue, "none", len) == 0)) { ResetFlag(statePtr, CHANNEL_LINEBUFFERED); SetFlag(statePtr, CHANNEL_UNBUFFERED); } else if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -buffering: must be one of" " full, line, or none", -1)); return TCL_ERROR; } return TCL_OK; } else if (HaveOpt(7, "-buffersize")) { Tcl_WideInt newBufferSize; Tcl_Obj obj; int code; |
︙ | ︙ | |||
8325 8326 8327 8328 8329 8330 8331 | translation = TCL_TRANSLATE_CRLF; } else if (strcmp(readMode, "platform") == 0) { translation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " | | | 8322 8323 8324 8325 8326 8327 8328 8329 8330 8331 8332 8333 8334 8335 8336 | translation = TCL_TRANSLATE_CRLF; } else if (strcmp(readMode, "platform") == 0) { translation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; } /* * Reset the EOL flags since we need to look at any buffered data |
︙ | ︙ | |||
8374 8375 8376 8377 8378 8379 8380 | statePtr->outputTranslation = TCL_TRANSLATE_CRLF; } else if (strcmp(writeMode, "platform") == 0) { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " | | | 8371 8372 8373 8374 8375 8376 8377 8378 8379 8380 8381 8382 8383 8384 8385 | statePtr->outputTranslation = TCL_TRANSLATE_CRLF; } else if (strcmp(writeMode, "platform") == 0) { statePtr->outputTranslation = TCL_PLATFORM_TRANSLATION; } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "bad value for -translation: must be one of " "auto, binary, cr, lf, crlf, or platform", -1)); } Tcl_Free((void *)argv); return TCL_ERROR; } } Tcl_Free((void *)argv); return TCL_OK; |
︙ | ︙ | |||
9336 9337 9338 9339 9340 9341 9342 | inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | | 9333 9334 9335 9336 9337 9338 9339 9340 9341 9342 9343 9344 9345 9346 9347 9348 9349 9350 9351 9352 9353 9354 | inStatePtr = inPtr->state; outStatePtr = outPtr->state; if (BUSY_STATE(inStatePtr, TCL_READABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" is busy", Tcl_GetChannelName(inChan))); } return TCL_ERROR; } if (BUSY_STATE(outStatePtr, TCL_WRITABLE)) { if (interp) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "channel \"%s\" is busy", Tcl_GetChannelName(outChan))); } return TCL_ERROR; } readFlags = inStatePtr->flags; writeFlags = outStatePtr->flags; |
︙ | ︙ | |||
9414 9415 9416 9417 9418 9419 9420 | /* * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { | | | | 9411 9412 9413 9414 9415 9416 9417 9418 9419 9420 9421 9422 9423 9424 9425 9426 | /* * Special handling of -size 0 async transfers, so that the -command is * still called asynchronously. */ if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); return 0; } /* * Start copying data between the channels. */ return CopyData(csPtr, 0); |
︙ | ︙ | |||
9752 9753 9754 9755 9756 9757 9758 | underflow = 1; } else { /* * Read up to bufSize characters. */ if ((csPtr->toRead == (Tcl_WideInt) -1) | | | | 9749 9750 9751 9752 9753 9754 9755 9756 9757 9758 9759 9760 9761 9762 9763 9764 9765 9766 9767 9768 9769 9770 9771 | underflow = 1; } else { /* * Read up to bufSize characters. */ if ((csPtr->toRead == (Tcl_WideInt) -1) || (csPtr->toRead > (Tcl_WideInt) csPtr->bufSize)) { sizeb = csPtr->bufSize; } else { sizeb = csPtr->toRead; } if (moveBytes) { size = DoRead(inStatePtr->topChanPtr, csPtr->buffer, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING)); } else { size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb, !GotFlag(inStatePtr, CHANNEL_NONBLOCKING) ,0 /* No append */); /* * In case of a recoverable encoding error, any data before * the error should be written. This data is in the bufObj. |
︙ | ︙ | |||
10237 10238 10239 10240 10241 10242 10243 | } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } assert(!GotFlag(statePtr, CHANNEL_EOF) | | < | 10234 10235 10236 10237 10238 10239 10240 10241 10242 10243 10244 10245 10246 10247 10248 | } } if (bytesToRead == 0) { ResetFlag(statePtr, CHANNEL_BLOCKED); } assert(!GotFlag(statePtr, CHANNEL_EOF) || GotFlag(statePtr, CHANNEL_STICKY_EOF|CHANNEL_ENCODING_ERROR) || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0); assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED) == (CHANNEL_EOF|CHANNEL_BLOCKED))); UpdateInterest(chanPtr); TclChannelRelease((Tcl_Channel)chanPtr); return (Tcl_Size)(p - dst); } |
︙ | ︙ | |||
10476 10477 10478 10479 10480 10481 10482 | * Note that we cannot have a message in the interpreter bypass * area, StackSetBlockMode is restricted to the channel bypass. * We still need the interp as the destination of the move. */ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 10472 10473 10474 10475 10476 10477 10478 10479 10480 10481 10482 10483 10484 10485 10486 | * Note that we cannot have a message in the interpreter bypass * area, StackSetBlockMode is restricted to the channel bypass. * We still need the interp as the destination of the move. */ if (!TclChanCaughtErrorBypass(interp, (Tcl_Channel) chanPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "error setting blocking mode: %s", Tcl_PosixError(interp))); } } else { /* * TIP #219. * If we have no interpreter to put a bypass message into we have * to clear it, to prevent its propagation and use in other places |
︙ | ︙ | |||
11101 11102 11103 11104 11105 11106 11107 | iPtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(iPtr->chanMsg); } else { iPtr->chanMsg = NULL; } if (disposePtr != NULL) { | | | 11097 11098 11099 11100 11101 11102 11103 11104 11105 11106 11107 11108 11109 11110 11111 | iPtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(iPtr->chanMsg); } else { iPtr->chanMsg = NULL; } if (disposePtr != NULL) { TclDecrRefCount(disposePtr); } return; } /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
11139 11140 11141 11142 11143 11144 11145 | statePtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(statePtr->chanMsg); } else { statePtr->chanMsg = NULL; } if (disposePtr != NULL) { | | | 11135 11136 11137 11138 11139 11140 11141 11142 11143 11144 11145 11146 11147 11148 11149 | statePtr->chanMsg = FixLevelCode(msg); Tcl_IncrRefCount(statePtr->chanMsg); } else { statePtr->chanMsg = NULL; } if (disposePtr != NULL) { TclDecrRefCount(disposePtr); } return; } /* *---------------------------------------------------------------------- * |
︙ | ︙ |
Changes to generic/tclIORChan.c.
︙ | ︙ | |||
74 75 76 77 78 79 80 | NULL, /* Get OS handle from the channel. NULL'able */ ReflectClose, /* No close2 support. NULL'able */ ReflectBlock, /* Set blocking/nonblocking. NULL'able */ NULL, /* Flush channel. Not used by core. NULL'able */ NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ #if TCL_THREADS | | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 | NULL, /* Get OS handle from the channel. NULL'able */ ReflectClose, /* No close2 support. NULL'able */ ReflectBlock, /* Set blocking/nonblocking. NULL'able */ NULL, /* Flush channel. Not used by core. NULL'able */ NULL, /* Handle events. NULL'able */ ReflectSeekWide, /* Move access point (64 bit). NULL'able */ #if TCL_THREADS ReflectThread, /* thread action, tracking owner */ #else NULL, /* thread action */ #endif ReflectTruncate /* Truncate. NULL'able */ }; /* |
︙ | ︙ | |||
96 97 98 99 100 101 102 | * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ | | | | | 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 | * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ Tcl_Obj *name; /* Name of the channel as created */ int mode; /* Mask of R/W mode */ int interest; /* Mask of events the channel is interested * in. */ int dead; /* Boolean signal that some operations * should no longer be attempted. */ Tcl_TimerToken readTimer; /* A token for the timer that is scheduled in order to call Tcl_NotifyChannel when the channel is readable */ Tcl_TimerToken writeTimer; /* A token for the timer that is scheduled in order to call Tcl_NotifyChannel when the channel is writable */ /* * Note regarding the usage of timers. * * Most channel implementations need a timer in the C level to ensure that * data in buffers is flushed out through the generation of fake file * events. |
︙ | ︙ | |||
609 610 611 612 613 614 615 | * Verify the result. * - List, of method names. Convert to mask. * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { | | | | | 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 | * Verify the result. * - List, of method names. Convert to mask. * Check for non-optionals through the mask. * Compare open mode against optional r/w. */ if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", TclGetString(cmdObj), TclGetString(resObj))); Tcl_DecrRefCount(resObj); goto error; } methods = 0; while (listc > 0) { if (Tcl_GetIndexFromObj(interp, listv[listc-1], methodNames, |
︙ | ︙ | |||
635 636 637 638 639 640 641 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { | | | | | | | | | | | | | | | | | 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 | methods |= FLAG(methIndex); listc--; } Tcl_DecrRefCount(resObj); if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" does not support all required methods", TclGetString(cmdObj))); goto error; } if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"read\" method", TclGetString(cmdObj))); goto error; } if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" lacks a \"write\" method", TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cget\" but not \"cgetall\"", TclGetString(cmdObj))); goto error; } if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s\" supports \"cgetall\" but not \"cget\"", TclGetString(cmdObj))); goto error; } Tcl_ResetResult(interp); /* * Everything is fine now. |
︙ | ︙ | |||
738 739 740 741 742 743 744 | #endif /* * Return handle as result of command. */ Tcl_SetObjResult(interp, | | | 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 | #endif /* * Return handle as result of command. */ Tcl_SetObjResult(interp, Tcl_NewStringObj(chanPtr->state->channelName, -1)); return TCL_OK; error: Tcl_DecrRefCount(rcPtr->name); Tcl_DecrRefCount(rcPtr->methods); Tcl_DecrRefCount(rcPtr->cmd); Tcl_Free(rcPtr); |
︙ | ︙ | |||
810 811 812 813 814 815 816 | * latter ensures that no pending events of this type are run on an * invalid channel. */ ReflectEvent *e = (ReflectEvent *) ev; if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { | | | 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 | * latter ensures that no pending events of this type are run on an * invalid channel. */ ReflectEvent *e = (ReflectEvent *) ev; if ((ev->proc != ReflectEventRun) || ((cd != NULL) && (cd != e->rcPtr))) { return 0; } return 1; } #endif int TclChanPostEventObjCmd( |
︙ | ︙ | |||
869 870 871 872 873 874 875 | chanId = TclGetString(objv[CHAN]); rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 | chanId = TclGetString(objv[CHAN]); rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, chanId); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "can not find reflected channel named \"%s\"", chanId)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CHANNEL", chanId, (char *)NULL); return TCL_ERROR; } /* * Note that the search above subsumes several of the older checks, * namely: |
︙ | ︙ | |||
933 934 935 936 937 938 939 | /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( | | | | 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | /* * Check that the channel is actually interested in the provided events. */ if (events & ~rcPtr->interest) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "tried to post events channel \"%s\" is not interested in", chanId)); return TCL_ERROR; } /* * We have the channel and the events to post. */ |
︙ | ︙ | |||
959 960 961 962 963 964 965 | if (rcPtr->writeTimer == NULL) { rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, TimerRunWrite, rcPtr); } } #if TCL_THREADS } else { | | | | | | | | | | | | | | | | | | | | | | | | | | | 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | if (rcPtr->writeTimer == NULL) { rcPtr->writeTimer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, TimerRunWrite, rcPtr); } } #if TCL_THREADS } else { ReflectEvent *ev = (ReflectEvent *)Tcl_Alloc(sizeof(ReflectEvent)); ev->header.proc = ReflectEventRun; ev->events = events; ev->rcPtr = rcPtr; /* * We are not preserving the structure here. When the channel is * closed any pending events are deleted, see ReflectClose(), and * ReflectEventDelete(). Trying to preserve and later release when the * event is run may generate a situation where the channel structure * is deleted but not our structure, crashing in * FreeReflectedChannel(). * * Force creation of the RCM, for proper cleanup on thread teardown. * The teardown of unprocessed events is currently coupled to the * thread reflected channel map */ (void) GetThreadReflectedChannelMap(); /* * XXX Race condition !! * XXX The destination thread may not exist anymore already. * XXX (Delayed postevent executed after channel got removed). * XXX Can we detect this ? (check the validity of the owner threadid ?) * XXX Actually, in that case the channel should be dead also ! */ Tcl_ThreadQueueEvent(rcPtr->owner, (Tcl_Event *) ev, TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY); } #endif /* * Squash interp results left by the event script. */ |
︙ | ︙ | |||
1203 1204 1205 1206 1207 1208 1209 | #if TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; | | | | | | 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 | #if TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; /* * Now squash the pending reflection events for this channel. */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { FreeReceivedError(&p); } } #endif |
︙ | ︙ | |||
1241 1242 1243 1244 1245 1246 1247 | #if TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; | | | | | | 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 | #if TCL_THREADS if (rcPtr->thread != Tcl_GetCurrentThread()) { ForwardParam p; ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p); result = p.base.code; /* * Now squash the pending reflection events for this channel. */ Tcl_DeleteEvents(ReflectEventDelete, rcPtr); if (result != TCL_OK) { PassReceivedErrorInterp(interp, &p); } } else { #endif result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj); |
︙ | ︙ | |||
1380 1381 1382 1383 1384 1385 1386 | Tcl_IncrRefCount(toReadObj); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; | | | | 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 | Tcl_IncrRefCount(toReadObj); if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } bytev = Tcl_GetBytesFromObj(NULL, resObj, &bytec); if (bytev == NULL) { SetChannelErrorStr(rcPtr->chan, msg_read_nonbyte); goto invalid; |
︙ | ︙ | |||
1464 1465 1466 1467 1468 1469 1470 | if (p.base.code < 0) { /* * No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { | | | | | 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 | if (p.base.code < 0) { /* * No error message, this is an errno signal. */ *errorCodePtr = -p.base.code; } else { PassReceivedError(rcPtr->chan, &p); *errorCodePtr = EINVAL; } p.output.toWrite = -1; } else { *errorCodePtr = EOK; } return p.output.toWrite; } |
︙ | ︙ | |||
1490 1491 1492 1493 1494 1495 1496 | Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; | | | | | | | | 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 | Tcl_IncrRefCount(bufObj); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { *errorCodePtr = -code; goto error; } Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } if (Tcl_InterpDeleted(rcPtr->interp)) { /* * The interp was destroyed during InvokeTclMethod(). */ SetChannelErrorStr(rcPtr->chan, msg_send_dstlost); goto invalid; } if (Tcl_GetIntFromObj(rcPtr->interp, resObj, &written) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; } if ((written == 0) && (toWrite > 0)) { /* * The handler claims to have written nothing of what it was given. * That is bad. */ SetChannelErrorStr(rcPtr->chan, msg_write_nothing); goto invalid; } if (toWrite < written) { /* * The handler claims to have written more than it was given. That is * bad. Note that the I/O core would crash if we were to return this * information, trying to write -nnn bytes in the next iteration. */ SetChannelErrorStr(rcPtr->chan, msg_write_toomuch); goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(bufObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr->interp); |
︙ | ︙ | |||
1603 1604 1605 1606 1607 1608 1609 | /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */ Tcl_Preserve(rcPtr); TclNewIntObj(offObj, offset); baseObj = Tcl_NewStringObj( | | | | | | | 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 | /* ASSERT: rcPtr->method & FLAG(METH_SEEK) */ Tcl_Preserve(rcPtr); TclNewIntObj(offObj, offset); baseObj = Tcl_NewStringObj( (seekMode == SEEK_SET) ? "start" : (seekMode == SEEK_CUR) ? "current" : "end", -1); Tcl_IncrRefCount(offObj); Tcl_IncrRefCount(baseObj); if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) { Tcl_SetChannelError(rcPtr->chan, resObj); goto invalid; } if (TclGetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) { Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp)); goto invalid; } if (newLoc < 0) { SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart); goto invalid; } *errorCodePtr = EOK; stop: Tcl_DecrRefCount(offObj); Tcl_DecrRefCount(baseObj); Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ |
︙ | ︙ | |||
1801 1802 1803 1804 1805 1806 1807 | void *clientData, int action) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; switch (action) { case TCL_CHANNEL_THREAD_INSERT: | | | | | | | | 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 1819 1820 1821 1822 | void *clientData, int action) { ReflectedChannel *rcPtr = (ReflectedChannel *)clientData; switch (action) { case TCL_CHANNEL_THREAD_INSERT: rcPtr->owner = Tcl_GetCurrentThread(); break; case TCL_CHANNEL_THREAD_REMOVE: rcPtr->owner = NULL; break; default: Tcl_Panic("Unknown thread action code."); break; } } #endif /* *---------------------------------------------------------------------- * |
︙ | ︙ | |||
1967 1968 1969 1970 1971 1972 1973 | } else { /* * Retrieve the value of one option. */ method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); | | | | | | | | | 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037 2038 2039 2040 2041 2042 | } else { /* * Retrieve the value of one option. */ method = METH_CGET; optionObj = Tcl_NewStringObj(optionName, -1); Tcl_IncrRefCount(optionObj); } Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) { UnmarshallErrorResult(interp, resObj); goto error; } /* * The result has to go into the 'dsPtr' for propagation to the caller of * the driver. */ if (optionObj != NULL) { TclDStringAppendObj(dsPtr, resObj); goto ok; } /* * Extract the list and append each item as element. */ /* * NOTE (4): If we extract the string rep we can assume a properly quoted * string. Together with a separating space this way of simply appending * the whole string rep might be faster. It also doesn't check if the * result is a valid list. Nor that the list has an even number elements. */ if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { goto error; } if ((listc % 2) == 1) { /* * Odd number of elements is wrong. */ Tcl_ResetResult(interp); Tcl_SetObjResult(interp, Tcl_ObjPrintf( "Expected list with even number of " "elements, got %" TCL_SIZE_MODIFIER "d element%s instead", listc, (listc == 1 ? "" : "s"))); goto error; } else { Tcl_Size len; const char *str = TclGetStringFromObj(resObj, &len); if (len) { TclDStringAppendLiteral(dsPtr, " "); Tcl_DStringAppend(dsPtr, str, len); } goto ok; } ok: result = TCL_OK; stop: if (optionObj) { Tcl_DecrRefCount(optionObj); } Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */ Tcl_Release(rcPtr); return result; error: result = TCL_ERROR; goto stop; |
︙ | ︙ | |||
2382 2383 2384 2385 2386 2387 2388 | if (resultObjPtr != NULL) { resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } | | | | | | 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 | if (resultObjPtr != NULL) { resObj = Tcl_NewStringObj(msg_dstlost,-1); *resultObjPtr = resObj; Tcl_IncrRefCount(resObj); } /* * Not touching argOneObj, argTwoObj, they have not been used. * See the contract as well. */ return TCL_ERROR; } /* * Insert method into the callback command, after the command prefix, * before the channel id. |
︙ | ︙ | |||
2681 2682 2683 2684 2685 2686 2687 | continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. | | | | | | | 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 | continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. * * Attention: Results may have been detached already, by either the * receiver, or this thread, as part of other parts in the thread * teardown. Such results are ignored. See ticket [b47b176adf] for the * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* * Basic crash safety until this routine can get revised [3411310] */ |
︙ | ︙ | |||
2834 2835 2836 2837 2838 2839 2840 | continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. | | | | | | | 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 | continue; } /* * The receiver for the event exited, before processing the event. We * detach the result now, wake the originator up and signal failure. * * Attention: Results may have been detached already, by either the * receiver, or this thread, as part of other parts in the thread * teardown. Such results are ignored. See ticket [b47b176adf] for the * identical race condition in Tcl 8.6 IORTrans. */ evPtr = resultPtr->evPtr; /* * Basic crash safety until this routine can get revised [3411310] */ |
︙ | ︙ | |||
3047 3048 3049 3050 3051 3052 3053 | ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr; ForwardingResult *resultPtr = evPtr->resultPtr; ReflectedChannel *rcPtr = evPtr->rcPtr; Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in | | | 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 | ForwardingEvent *evPtr = (ForwardingEvent *) evGPtr; ForwardingResult *resultPtr = evPtr->resultPtr; ReflectedChannel *rcPtr = evPtr->rcPtr; Tcl_Interp *interp = rcPtr->interp; ForwardParam *paramPtr = evPtr->param; Tcl_Obj *resObj = NULL; /* Interp result of InvokeTclMethod */ ReflectedChannelMap *rcmPtr;/* Map of reflected channels with handlers in * this interp. */ Tcl_HashEntry *hPtr; /* Entry in the above map */ /* * Ignore the event if no one is waiting for its result anymore. */ if (!resultPtr) { |
︙ | ︙ | |||
3090 3091 3092 3093 3094 3095 3096 | * We remove the channel from both interpreter and thread maps before * releasing the memory, to prevent future accesses (like by * 'postevent') from finding and dereferencing a dangling pointer. */ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, | | | | 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 | * We remove the channel from both interpreter and thread maps before * releasing the memory, to prevent future accesses (like by * 'postevent') from finding and dereferencing a dangling pointer. */ rcmPtr = GetReflectedChannelMap(interp); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); rcmPtr = GetThreadReflectedChannelMap(); hPtr = Tcl_FindHashEntry(&rcmPtr->map, Tcl_GetChannelName(rcPtr->chan)); Tcl_DeleteHashEntry(hPtr); MarkDead(rcPtr); break; } case ForwardedInput: { Tcl_Obj *toReadObj; |
︙ | ︙ | |||
3140 3141 3142 3143 3144 3145 3146 | } else { if (bytec > 0) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } } | | | | | | | 3140 3141 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 3158 3159 3160 3161 3162 3163 3164 | } else { if (bytec > 0) { memcpy(paramPtr->input.buf, bytev, bytec); } paramPtr->input.toRead = bytec; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(toReadObj); break; } case ForwardedOutput: { Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *) paramPtr->output.buf, paramPtr->output.toWrite); Tcl_IncrRefCount(bufObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) { int code = ErrnoReturn(rcPtr, resObj); if (code < 0) { paramPtr->base.code = code; } else { ForwardSetObjError(paramPtr, resObj); |
︙ | ︙ | |||
3179 3180 3181 3182 3183 3184 3185 | } else if (written==0 || paramPtr->output.toWrite<written) { ForwardSetStaticError(paramPtr, msg_write_toomuch); paramPtr->output.toWrite = -1; } else { paramPtr->output.toWrite = written; } } | | | | 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 | } else if (written==0 || paramPtr->output.toWrite<written) { ForwardSetStaticError(paramPtr, msg_write_toomuch); paramPtr->output.toWrite = -1; } else { paramPtr->output.toWrite = written; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(bufObj); break; } case ForwardedSeek: { Tcl_Obj *offObj; Tcl_Obj *baseObj; |
︙ | ︙ | |||
3222 3223 3224 3225 3226 3227 3228 | } else { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } } | | | | | | | | | | | | | | | | | | | | | | | | | | 3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239 3240 3241 3242 3243 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 3291 3292 3293 3294 3295 3296 3297 3298 3299 3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317 3318 3319 3320 3321 3322 | } else { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); paramPtr->seek.offset = -1; } } Tcl_Release(rcPtr); Tcl_DecrRefCount(offObj); Tcl_DecrRefCount(baseObj); break; } case ForwardedWatch: { Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask); /* assert maskObj.refCount == 1 */ Tcl_Preserve(rcPtr); rcPtr->interest = paramPtr->watch.mask; (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL); Tcl_DecrRefCount(maskObj); Tcl_Release(rcPtr); break; } case ForwardedBlock: { Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking); Tcl_IncrRefCount(blockObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(blockObj); break; } case ForwardedSetOpt: { Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1); Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1); Tcl_IncrRefCount(optionObj); Tcl_IncrRefCount(valueObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj, &resObj) != TCL_OK) { ForwardSetObjError(paramPtr, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); Tcl_DecrRefCount(valueObj); break; } case ForwardedGetOpt: { /* * Retrieve the value of one option. */ Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1); Tcl_IncrRefCount(optionObj); Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { TclDStringAppendObj(paramPtr->getOpt.value, resObj); } Tcl_Release(rcPtr); Tcl_DecrRefCount(optionObj); break; } case ForwardedGetOptAll: /* * Retrieve all options. */ Tcl_Preserve(rcPtr); if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){ ForwardSetObjError(paramPtr, resObj); } else { /* * Extract list, validate that it is a list, and #elements. See * NOTE (4) as well. */ Tcl_Size listc; Tcl_Obj **listv; if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); ForwardSetObjError(paramPtr, resObj); } else if ((listc % 2) == 1) { /* * Odd number of elements is wrong. [x]. */ |
︙ | ︙ | |||
3333 3334 3335 3336 3337 3338 3339 | if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } | | | 3333 3334 3335 3336 3337 3338 3339 3340 3341 3342 3343 3344 3345 3346 3347 | if (len) { TclDStringAppendLiteral(paramPtr->getOpt.value, " "); Tcl_DStringAppend(paramPtr->getOpt.value, str, len); } } } Tcl_Release(rcPtr); break; case ForwardedTruncate: { Tcl_Obj *lenObj = Tcl_NewWideIntObj(paramPtr->truncate.length); Tcl_IncrRefCount(lenObj); Tcl_Preserve(rcPtr); |
︙ | ︙ |
Changes to generic/tclInterp.c.
︙ | ︙ | |||
47 48 49 50 51 52 53 | * This is used by alias deletion to remove * the alias from the child interpreter alias * table. */ struct Target *targetPtr; /* Entry for target command in parent. This is * used in the parent interpreter to map back * from the target command to aliases * redirecting to it. */ | | | 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 | * This is used by alias deletion to remove * the alias from the child interpreter alias * table. */ struct Target *targetPtr; /* Entry for target command in parent. This is * used in the parent interpreter to map back * from the target command to aliases * redirecting to it. */ Tcl_Size objc; /* Count of Tcl_Obj in the prefix of the * target command to be invoked in the target * interpreter. Additional arguments specified * when calling the alias in the child interp * will be appended to the prefix before the * command is invoked. */ Tcl_Obj *objPtr; /* The first actual prefix object - the target * command name; this has to be at the end of |
︙ | ︙ | |||
211 212 213 214 215 216 217 | /* * Prototypes for local static functions: */ static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Interp *parentInterp, | | | | | | | | | | | | | | | 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 | /* * Prototypes for local static functions: */ static int AliasCreate(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Interp *parentInterp, Tcl_Obj *namePtr, Tcl_Obj *targetPtr, Tcl_Size objc, Tcl_Obj *const objv[]); static int AliasDelete(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *namePtr); static int AliasDescribe(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Obj *objPtr); static int AliasList(Tcl_Interp *interp, Tcl_Interp *childInterp); static Tcl_ObjCmdProc AliasNRCmd; static Tcl_CmdDeleteProc AliasObjCmdDeleteProc; static Tcl_Interp * GetInterp(Tcl_Interp *interp, Tcl_Obj *pathPtr); static Tcl_Interp * GetInterp2(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_InterpDeleteProc InterpInfoDeleteProc; static int ChildBgerror(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_Interp * ChildCreate(Tcl_Interp *interp, Tcl_Obj *pathPtr, int safe); static int ChildDebugCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildEval(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildExpose(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildHide(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildHidden(Tcl_Interp *interp, Tcl_Interp *childInterp); static int ChildInvokeHidden(Tcl_Interp *interp, Tcl_Interp *childInterp, const char *namespaceName, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildMarkTrusted(Tcl_Interp *interp, Tcl_Interp *childInterp); static Tcl_CmdDeleteProc ChildObjCmdDeleteProc; static int ChildRecursionLimit(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildCommandLimitCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size consumedObjc, Tcl_Size objc, Tcl_Obj *const objv[]); static int ChildTimeLimitCmd(Tcl_Interp *interp, Tcl_Interp *childInterp, Tcl_Size consumedObjc, Tcl_Size objc, Tcl_Obj *const objv[]); static void InheritLimitsFromParent(Tcl_Interp *childInterp, Tcl_Interp *parentInterp); static void SetScriptLimitCallback(Tcl_Interp *interp, int type, Tcl_Interp *targetInterp, Tcl_Obj *scriptObj); static void CallScriptLimitCallback(void *clientData, Tcl_Interp *interp); static void DeleteScriptLimitCallback(void *clientData); |
︙ | ︙ | |||
706 707 708 709 710 711 712 | } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildBgerror(interp, childInterp, objc - 3, objv + 3); case OPT_CANCEL: { | > | | 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 | } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildBgerror(interp, childInterp, objc - 3, objv + 3); case OPT_CANCEL: { Tcl_Size i; int flags; Tcl_Obj *resultObjPtr; static const char *const cancelOptions[] = { "-unwind", "--", NULL }; enum optionCancelEnum { OPT_UNWIND, OPT_LAST } idx; |
︙ | ︙ | |||
778 779 780 781 782 783 784 | } else { resultObjPtr = NULL; } return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { | | > | 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 | } else { resultObjPtr = NULL; } return Tcl_CancelEval(childInterp, resultObjPtr, 0, flags); } case OPT_CREATE: { int last, safe; Tcl_Size i; Tcl_Obj *childPtr; char buf[16 + TCL_INTEGER_SPACE]; static const char *const createOptions[] = { "-safe", "--", NULL }; enum option { OPT_SAFE, OPT_LAST |
︙ | ︙ | |||
829 830 831 832 833 834 835 | * for the interpreter does not collide with an existing command * in the parent interpreter. */ for (i = 0; ; i++) { Tcl_CmdInfo cmdInfo; | | | 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 | * for the interpreter does not collide with an existing command * in the parent interpreter. */ for (i = 0; ; i++) { Tcl_CmdInfo cmdInfo; snprintf(buf, sizeof(buf), "interp%" TCL_SIZE_MODIFIER "d", i); if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) { break; } } childPtr = Tcl_NewStringObj(buf, -1); } if (ChildCreate(interp, childPtr, safe) == NULL) { |
︙ | ︙ | |||
860 861 862 863 864 865 866 | } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3); case OPT_DELETE: { | | | 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 | } childInterp = GetInterp(interp, objv[2]); if (childInterp == NULL) { return TCL_ERROR; } return ChildDebugCmd(interp, childInterp, objc - 3, objv + 3); case OPT_DELETE: { Tcl_Size i; InterpInfo *iiPtr; for (i = 2; i < objc; i++) { childInterp = GetInterp(interp, objv[i]); if (childInterp == NULL) { return TCL_ERROR; } else if (childInterp == interp) { |
︙ | ︙ | |||
938 939 940 941 942 943 944 | childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHID: { | | | 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 | childInterp = GetInterp2(interp, objc, objv); if (childInterp == NULL) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHID: { Tcl_Size i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST } idx; |
︙ | ︙ | |||
1159 1160 1161 1162 1163 1164 1165 | *--------------------------------------------------------------------------- */ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ | | | 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 | *--------------------------------------------------------------------------- */ static Tcl_Interp * GetInterp2( Tcl_Interp *interp, /* Default interp if no interp was specified * on the command line. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { if (objc == 2) { return interp; } else if (objc == 3) { return GetInterp(interp, objv[2]); } else { |
︙ | ︙ | |||
1272 1273 1274 1275 1276 1277 1278 | Tcl_DecrRefCount(targetObjPtr); return result; } /* *---------------------------------------------------------------------- * | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | | | | | | 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 | Tcl_DecrRefCount(targetObjPtr); return result; } /* *---------------------------------------------------------------------- * * Tcl_GetAliasObj -- * * Object version: Gets information about an alias. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int Tcl_GetAliasObj( Tcl_Interp *interp, /* Interp to start search from. */ const char *aliasName, /* Name of alias to find. */ Tcl_Interp **targetInterpPtr, /* (Return) target interpreter. */ const char **targetCmdPtr, /* (Return) name of target command. */ Tcl_Size *objcPtr, /* (Return) count of addnl args. */ Tcl_Obj ***objvPtr) /* (Return) additional args. */ { InterpInfo *iiPtr = (InterpInfo *) ((Interp *) interp)->interpInfo; Tcl_HashEntry *hPtr; Alias *aliasPtr; Tcl_Size objc; Tcl_Obj **objv; hPtr = Tcl_FindHashEntry(&iiPtr->child.aliasTable, aliasName); if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "alias \"%s\" not found", aliasName)); Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ALIAS", aliasName, (char *)NULL); return TCL_ERROR; } aliasPtr = (Alias *)Tcl_GetHashValue(hPtr); objc = aliasPtr->objc; objv = &aliasPtr->objPtr; if (targetInterpPtr != NULL) { *targetInterpPtr = aliasPtr->targetInterp; } if (targetCmdPtr != NULL) { *targetCmdPtr = TclGetString(objv[0]); } if (objcPtr != NULL) { *objcPtr = objc - 1; } if (objvPtr != NULL) { *objvPtr = objv + 1; } |
︙ | ︙ | |||
1517 1518 1519 1520 1521 1522 1523 | AliasCreate( Tcl_Interp *interp, /* Interp for error reporting. */ Tcl_Interp *childInterp, /* Interp where alias cmd will live or from * which alias will be deleted. */ Tcl_Interp *parentInterp, /* Interp in which target command will be * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ | | | | > | | | 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 | AliasCreate( Tcl_Interp *interp, /* Interp for error reporting. */ Tcl_Interp *childInterp, /* Interp where alias cmd will live or from * which alias will be deleted. */ Tcl_Interp *parentInterp, /* Interp in which target command will be * invoked. */ Tcl_Obj *namePtr, /* Name of alias cmd. */ Tcl_Obj *targetCmdPtr, /* Name of target cmd. */ Tcl_Size objc, /* Additional arguments to store */ Tcl_Obj *const objv[]) /* with alias. */ { Alias *aliasPtr; Tcl_HashEntry *hPtr; Target *targetPtr; Child *childPtr; Parent *parentPtr; Tcl_Obj **prefv; int isNew; Tcl_Size i; aliasPtr = (Alias *)Tcl_Alloc(sizeof(Alias) + objc * sizeof(Tcl_Obj *)); aliasPtr->token = namePtr; Tcl_IncrRefCount(aliasPtr->token); aliasPtr->targetInterp = parentInterp; aliasPtr->objc = objc + 1; prefv = &aliasPtr->objPtr; *prefv = targetCmdPtr; Tcl_IncrRefCount(targetCmdPtr); for (i = 0; i < objc; i++) { *(++prefv) = objv[i]; Tcl_IncrRefCount(objv[i]); } Tcl_Preserve(childInterp); Tcl_Preserve(parentInterp); |
︙ | ︙ | |||
1569 1570 1571 1572 1573 1574 1575 | * careful to wipe out its client data first, so the command doesn't * try to delete itself. */ Command *cmdPtr; Tcl_DecrRefCount(aliasPtr->token); | | | 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 | * careful to wipe out its client data first, so the command doesn't * try to delete itself. */ Command *cmdPtr; Tcl_DecrRefCount(aliasPtr->token); Tcl_DecrRefCount(targetCmdPtr); for (i = 0; i < objc; i++) { Tcl_DecrRefCount(objv[i]); } cmdPtr = (Command *) aliasPtr->childCmd; cmdPtr->clientData = NULL; cmdPtr->deleteProc = NULL; |
︙ | ︙ | |||
1823 1824 1825 1826 1827 1828 1829 | AliasNRCmd( void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { Alias *aliasPtr = (Alias *)clientData; | | | 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 | AliasNRCmd( void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { Alias *aliasPtr = (Alias *)clientData; Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *listPtr; ListRep listRep; int flags = TCL_EVAL_INVOKE; /* * Append the arguments to the command prefix and invoke the command in |
︙ | ︙ | |||
1878 1879 1880 1881 1882 1883 1884 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; Tcl_Interp *targetInterp = aliasPtr->targetInterp; | | > | 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 | Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; Tcl_Interp *targetInterp = aliasPtr->targetInterp; int result; Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *tPtr = (Interp *) targetInterp; int isRootEnsemble; /* * Append the arguments to the command prefix and invoke the command in |
︙ | ︙ | |||
1968 1969 1970 1971 1972 1973 1974 | void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; | | > | 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 | void *clientData, /* Alias record. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument vector. */ { #define ALIAS_CMDV_PREALLOC 10 Alias *aliasPtr = (Alias *)clientData; int result; Tcl_Size prefc, cmdc, i; Tcl_Obj **prefv, **cmdv; Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; Interp *iPtr = (Interp *) interp; int isRootEnsemble; /* * Append the arguments to the command prefix and invoke the command in |
︙ | ︙ | |||
2050 2051 2052 2053 2054 2055 2056 | static void AliasObjCmdDeleteProc( void *clientData) /* The alias record for this alias. */ { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; | | | 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 | static void AliasObjCmdDeleteProc( void *clientData) /* The alias record for this alias. */ { Alias *aliasPtr = (Alias *)clientData; Target *targetPtr; Tcl_Size i; Tcl_Obj **objv; Tcl_DecrRefCount(aliasPtr->token); objv = &aliasPtr->objPtr; for (i = 0; i < aliasPtr->objc; i++) { Tcl_DecrRefCount(objv[i]); } |
︙ | ︙ | |||
2374 2375 2376 2377 2378 2379 2380 | *---------------------------------------------------------------------- */ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ | | | 2317 2318 2319 2320 2321 2322 2323 2324 2325 2326 2327 2328 2329 2330 2331 | *---------------------------------------------------------------------- */ static int ChildBgerror( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc) { Tcl_Size length; if (TCL_ERROR == TclListObjLength(NULL, objv[0], &length) || (length < 1)) { |
︙ | ︙ | |||
2660 2661 2662 2663 2664 2665 2666 | if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { | | | 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 | if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(Tcl_IsSafe(childInterp))); return TCL_OK; case OPT_INVOKEHIDDEN: { Tcl_Size i; const char *namespaceName; static const char *const hiddenOptions[] = { "-global", "-namespace", "--", NULL }; enum hiddenOption { OPT_GLOBAL, OPT_NAMESPACE, OPT_LAST } idx; |
︙ | ︙ | |||
2809 2810 2811 2812 2813 2814 2815 | */ static int ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ | | | 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 | */ static int ChildDebugCmd( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const debugTypes[] = { "-frame", NULL }; enum DebugTypes { DEBUG_TYPE_FRAME |
︙ | ︙ | |||
2880 2881 2882 2883 2884 2885 2886 | */ static int ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ | | | 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 | */ static int ChildEval( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command * will be evaluated. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; /* * TIP #285: If necessary, reset the cancellation flags for the child * interpreter now; otherwise, canceling a script in a parent interpreter |
︙ | ︙ | |||
2943 2944 2945 2946 2947 2948 2949 | *---------------------------------------------------------------------- */ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ | | | 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 | *---------------------------------------------------------------------- */ static int ChildExpose( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot expose commands", |
︙ | ︙ | |||
2987 2988 2989 2990 2991 2992 2993 | *---------------------------------------------------------------------- */ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ | | | 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 | *---------------------------------------------------------------------- */ static int ChildRecursionLimit( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which limit is set/queried. */ Tcl_Size objc, /* Set or Query. */ Tcl_Obj *const objv[]) /* Argument strings. */ { Interp *iPtr; Tcl_WideInt limit; if (objc) { if (Tcl_IsSafe(interp)) { |
︙ | ︙ | |||
3049 3050 3051 3052 3053 3054 3055 | *---------------------------------------------------------------------- */ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ | | | 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 | *---------------------------------------------------------------------- */ static int ChildHide( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* Interp in which command will be exposed. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument strings. */ { const char *name; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "permission denied: safe interpreter cannot hide commands", |
︙ | ︙ | |||
3134 3135 3136 3137 3138 3139 3140 | static int ChildInvokeHidden( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ | | | 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 | static int ChildInvokeHidden( Tcl_Interp *interp, /* Interp for error return. */ Tcl_Interp *childInterp, /* The child interpreter in which command will * be invoked. */ const char *namespaceName, /* The namespace to use, if any. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; if (Tcl_IsSafe(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "not allowed to invoke hidden commands from safe interpreter", |
︙ | ︙ | |||
4477 4478 4479 4480 4481 4482 4483 | *---------------------------------------------------------------------- */ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ | | | | 4420 4421 4422 4423 4424 4425 4426 4427 4428 4429 4430 4431 4432 4433 4434 4435 | *---------------------------------------------------------------------- */ static int ChildCommandLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ Tcl_Size consumedObjc, /* Number of args already parsed. */ Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-value", NULL }; enum Options { OPT_CMD, OPT_GRAN, OPT_VAL |
︙ | ︙ | |||
4578 4579 4580 4581 4582 4583 4584 | break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { | < | | 4521 4522 4523 4524 4525 4526 4527 4528 4529 4530 4531 4532 4533 4534 4535 | break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { Tcl_Size i, scriptLen = 0, limitLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL, *limitObj = NULL; int gran = 0, limit = 0; for (i=consumedObjc ; i<objc ; i+=2) { if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; |
︙ | ︙ | |||
4665 4666 4667 4668 4669 4670 4671 | *---------------------------------------------------------------------- */ static int ChildTimeLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ | | | | 4607 4608 4609 4610 4611 4612 4613 4614 4615 4616 4617 4618 4619 4620 4621 4622 | *---------------------------------------------------------------------- */ static int ChildTimeLimitCmd( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Interp *childInterp, /* Interpreter being adjusted. */ Tcl_Size consumedObjc, /* Number of args already parsed. */ Tcl_Size objc, /* Total number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { static const char *const options[] = { "-command", "-granularity", "-milliseconds", "-seconds", NULL }; enum Options { OPT_CMD, OPT_GRAN, OPT_MILLI, OPT_SEC |
︙ | ︙ | |||
4783 4784 4785 4786 4787 4788 4789 | break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { | < | | 4725 4726 4727 4728 4729 4730 4731 4732 4733 4734 4735 4736 4737 4738 4739 | break; } return TCL_OK; } else if ((objc-consumedObjc) & 1 /* isOdd(objc-consumedObjc) */) { Tcl_WrongNumArgs(interp, consumedObjc, objv, "?-option value ...?"); return TCL_ERROR; } else { Tcl_Size i, scriptLen = 0, milliLen = 0, secLen = 0; Tcl_Obj *scriptObj = NULL, *granObj = NULL; Tcl_Obj *milliObj = NULL, *secObj = NULL; int gran = 0; Tcl_Time limitMoment; Tcl_WideInt tmp; Tcl_LimitGetTime(childInterp, &limitMoment); |
︙ | ︙ |
Changes to generic/tclObj.c.
︙ | ︙ | |||
2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 | return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewWideIntObj to create new wide integer end up calling the * debugging function Tcl_DbNewWideIntObj instead. We provide two * implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is * compiled to do memory debugging of the core is independent of whether | > > > > > > > > > > > > > > > > > > > > > > > > > > > | 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 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 | return objPtr; } #endif /* if TCL_MEM_DEBUG */ /* *---------------------------------------------------------------------- * * Tcl_NewWideUIntObj -- * * Results: * The newly created object is returned. This object will have an invalid * string representation. The returned object has ref count 0. * * Side effects: * None. * *---------------------------------------------------------------------- */ Tcl_Obj * Tcl_NewWideUIntObj( Tcl_WideUInt uwideValue) /* Wide integer used to initialize the new * object. */ { Tcl_Obj *objPtr; TclNewUIntObj(objPtr, uwideValue); return objPtr; } /* *---------------------------------------------------------------------- * * Tcl_DbNewWideIntObj -- * * If a client is compiled with TCL_MEM_DEBUG defined, calls to * Tcl_NewWideIntObj to create new wide integer end up calling the * debugging function Tcl_DbNewWideIntObj instead. We provide two * implementations of Tcl_DbNewWideIntObj so that whether the Tcl core is * compiled to do memory debugging of the core is independent of whether |
︙ | ︙ | |||
2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 | { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } TclSetIntObj(objPtr, wideValue); } /* *---------------------------------------------------------------------- * * Tcl_GetWideIntFromObj -- * * Attempt to return a wide integer from the Tcl object "objPtr". If the | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 | { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj"); } TclSetIntObj(objPtr, wideValue); } /* *---------------------------------------------------------------------- * * Tcl_SetWideUIntObj -- * * Modify an object to be a wide integer object or a bignum object * and to have the specified unsigned wide integer value. * * Results: * None. * * Side effects: * The object's old string rep, if any, is freed. Also, any old internal * rep is freed. * *---------------------------------------------------------------------- */ void Tcl_SetWideUIntObj( Tcl_Obj *objPtr, /* Object w. internal rep to init. */ Tcl_WideUInt uwideValue) /* Wide integer used to initialize the * object's value. */ { if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetWideUIntObj"); } if (uwideValue > WIDE_MAX) { mp_int bignumValue; if (mp_init_u64(&bignumValue, uwideValue) != MP_OKAY) { Tcl_Panic("%s: memory overflow", "Tcl_SetWideUIntObj"); } TclSetBignumInternalRep(objPtr, &bignumValue); } { TclSetIntObj(objPtr, (Tcl_WideInt)uwideValue); } } /* *---------------------------------------------------------------------- * * Tcl_GetWideIntFromObj -- * * Attempt to return a wide integer from the Tcl object "objPtr". If the |
︙ | ︙ |
Changes to generic/tclStrIdxTree.c.
︙ | ︙ | |||
57 58 59 60 61 62 63 | #include "tclStrIdxTree.h" static void StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr); static void StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr); static const Tcl_ObjType StrIdxTreeObjType = { | | | | | | | < | | | | | | 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 | #include "tclStrIdxTree.h" static void StrIdxTreeObj_DupIntRepProc(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void StrIdxTreeObj_FreeIntRepProc(Tcl_Obj *objPtr); static void StrIdxTreeObj_UpdateStringProc(Tcl_Obj *objPtr); static const Tcl_ObjType StrIdxTreeObjType = { "str-idx-tree", /* name */ StrIdxTreeObj_FreeIntRepProc, /* freeIntRepProc */ StrIdxTreeObj_DupIntRepProc, /* dupIntRepProc */ StrIdxTreeObj_UpdateStringProc, /* updateStringProc */ NULL, /* setFromAnyProc */ TCL_OBJTYPE_V0 }; /* *---------------------------------------------------------------------- * * TclStrIdxTreeSearch -- * * Find largest part of string "start" in indexed tree (case sensitive). * * Also used for building of string index tree. * * Results: * Return position of UTF character in start after last equal character * and found item (with parent). * * Side effects: * None. * *---------------------------------------------------------------------- */ const char * TclStrIdxTreeSearch( TclStrIdxTree **foundParent,/* Return value of found sub tree (used for tree build) */ TclStrIdx **foundItem, /* Return value of found item */ TclStrIdxTree *tree, /* Index tree will be browsed */ const char *start, /* UTF string to find in tree */ const char *end) /* End of string */ { TclStrIdxTree *parent = tree, *prevParent = tree; TclStrIdx *item = tree->firstPtr, *prevItem = NULL; const char *s = start, *f, *cin, *cinf, *prevf = NULL; Tcl_Size offs = 0; if (item == NULL) { |
︙ | ︙ | |||
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 | /* if something was found */ if (f > s) { /* if whole string was found */ if (f >= end) { start = f; goto done; } /* set new offset and shift start string */ offs += cinf - cin; s = f; /* if match item, go deeper as long as possible */ if (offs >= item->length && item->childTree.firstPtr) { /* save previuosly found item (if not ambigous) for * possible fallback (few greedy match) */ if (item->value != NULL) { prevf = f; prevItem = item; prevParent = parent; } parent = &item->childTree; item = item->childTree.firstPtr; continue; } /* no children - return this item and current chars found */ start = f; goto done; } item = item->nextPtr; } while (item != NULL); | > > > | 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 | /* if something was found */ if (f > s) { /* if whole string was found */ if (f >= end) { start = f; goto done; } /* set new offset and shift start string */ offs += cinf - cin; s = f; /* if match item, go deeper as long as possible */ if (offs >= item->length && item->childTree.firstPtr) { /* save previuosly found item (if not ambigous) for * possible fallback (few greedy match) */ if (item->value != NULL) { prevf = f; prevItem = item; prevParent = parent; } parent = &item->childTree; item = item->childTree.firstPtr; continue; } /* no children - return this item and current chars found */ start = f; goto done; } item = item->nextPtr; } while (item != NULL); |
︙ | ︙ | |||
172 173 174 175 176 177 178 179 180 181 182 183 184 185 | Tcl_Free(t); } } /* * Several bidirectional list primitives */ static inline void TclStrIdxTreeInsertBranch( TclStrIdxTree *parent, TclStrIdx *item, TclStrIdx *child) { if (parent->firstPtr == child) { | > | 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 | Tcl_Free(t); } } /* * Several bidirectional list primitives */ static inline void TclStrIdxTreeInsertBranch( TclStrIdxTree *parent, TclStrIdx *item, TclStrIdx *child) { if (parent->firstPtr == child) { |
︙ | ︙ | |||
232 233 234 235 236 237 238 | * Returns a standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ | < | < < < | 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 | * Returns a standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ int TclStrIdxTreeBuildFromList( TclStrIdxTree *idxTree, Tcl_Size lstc, Tcl_Obj **lstv, void **values) { Tcl_Obj **lwrv; Tcl_Size i; int ret = TCL_ERROR; void *val; const char *s, *e, *f; TclStrIdx *item; /* create lowercase reflection of the list keys */ lwrv = (Tcl_Obj **) Tcl_AttemptAlloc(sizeof(Tcl_Obj*) * lstc); if (lwrv == NULL) { return TCL_ERROR; } for (i = 0; i < lstc; i++) { lwrv[i] = Tcl_DuplicateObj(lstv[i]); Tcl_IncrRefCount(lwrv[i]); lwrv[i]->length = Tcl_UtfToLower(TclGetString(lwrv[i])); } /* build index tree of the list keys */ for (i = 0; i < lstc; i++) { TclStrIdxTree *foundParent = idxTree; |
︙ | ︙ | |||
279 280 281 282 283 284 285 | continue; } item = NULL; if (idxTree->firstPtr != NULL) { TclStrIdx *foundItem; | | < > | > | > > > | | 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 | continue; } item = NULL; if (idxTree->firstPtr != NULL) { TclStrIdx *foundItem; f = TclStrIdxTreeSearch(&foundParent, &foundItem, idxTree, s, e); /* if common prefix was found */ if (f > s) { /* ignore element if fulfilled or ambigous */ if (f == e) { continue; } /* if shortest key was found with the same value, * just replace its current key with longest key */ if (foundItem->value == val && foundItem->length <= lwrv[i]->length && foundItem->length <= (f - s) // only if found item is covered in full && foundItem->childTree.firstPtr == NULL) { TclSetObjRef(foundItem->key, lwrv[i]); foundItem->length = lwrv[i]->length; continue; } /* split tree (e. g. j->(jan,jun) + jul == j->(jan,ju->(jun,jul)) ) * but don't split by fulfilled child of found item ( ii->iii->iiii ) */ if (foundItem->length != (f - s)) { /* first split found item (insert one between parent and found + new one) */ item = (TclStrIdx *) Tcl_AttemptAlloc(sizeof(TclStrIdx)); if (item == NULL) { goto done; } TclInitObjRef(item->key, foundItem->key); item->length = f - s; /* set value or mark as ambigous if not the same value of both */ item->value = (foundItem->value == val) ? val : NULL; /* insert group item between foundParent and foundItem */ TclStrIdxTreeInsertBranch(foundParent, item, foundItem); foundParent = &item->childTree; } else { /* the new item should be added as child of found item */ foundParent = &foundItem->childTree; } } } /* append item at end of found parent */ item = (TclStrIdx *) Tcl_AttemptAlloc(sizeof(TclStrIdx)); if (item == NULL) { goto done; } item->childTree.lastPtr = item->childTree.firstPtr = NULL; TclInitObjRef(item->key, lwrv[i]); item->length = lwrv[i]->length; item->value = val; |
︙ | ︙ | |||
394 395 396 397 398 399 400 401 402 403 404 405 406 407 | static void StrIdxTreeObj_DupIntRepProc( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { /* follow links (smart pointers) */ srcPtr = FollowPossibleLink(srcPtr); /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ TclInitObjRef(*((Tcl_Obj **) ©Ptr->internalRep.twoPtrValue.ptr1), srcPtr); copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &StrIdxTreeObjType; } | > | 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 | static void StrIdxTreeObj_DupIntRepProc( Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) { /* follow links (smart pointers) */ srcPtr = FollowPossibleLink(srcPtr); /* create smart pointer to it (ptr1 != NULL, ptr2 = NULL) */ TclInitObjRef(*((Tcl_Obj **) ©Ptr->internalRep.twoPtrValue.ptr1), srcPtr); copyPtr->internalRep.twoPtrValue.ptr2 = NULL; copyPtr->typePtr = &StrIdxTreeObjType; } |
︙ | ︙ | |||
438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 | TclStrIdxTree * TclStrIdxTreeGetFromObj( Tcl_Obj *objPtr) { if (objPtr->typePtr != &StrIdxTreeObjType) { return NULL; } /* follow links (smart pointers) */ objPtr = FollowPossibleLink(objPtr); /* return tree root in internal representation */ return (TclStrIdxTree *) &objPtr->internalRep.twoPtrValue; } /* * Several debug primitives */ | > > | 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 | TclStrIdxTree * TclStrIdxTreeGetFromObj( Tcl_Obj *objPtr) { if (objPtr->typePtr != &StrIdxTreeObjType) { return NULL; } /* follow links (smart pointers) */ objPtr = FollowPossibleLink(objPtr); /* return tree root in internal representation */ return (TclStrIdxTree *) &objPtr->internalRep.twoPtrValue; } /* * Several debug primitives */ |
︙ | ︙ | |||
499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { case O_FINDEQUAL: if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } cs = TclGetString(objv[2]); cin = TclGetString(objv[3]); ret = TclUtfFindEqual( cs, cs + objv[1]->length, cin, cin + objv[2]->length); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); break; case O_INDEX: case O_PUTS_INDEX: { Tcl_Obj **lstv; | > > | | 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 | } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &optionIndex) != TCL_OK) { Tcl_SetErrorCode(interp, "CLOCK", "badOption", TclGetString(objv[1]), (char *)NULL); return TCL_ERROR; } switch (optionIndex) { case O_FINDEQUAL: if (objc < 4) { Tcl_WrongNumArgs(interp, 1, objv, ""); return TCL_ERROR; } cs = TclGetString(objv[2]); cin = TclGetString(objv[3]); ret = TclUtfFindEqual( cs, cs + objv[1]->length, cin, cin + objv[2]->length); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret - cs)); break; case O_INDEX: case O_PUTS_INDEX: { Tcl_Obj **lstv; Tcl_Size i, lstc; TclStrIdxTree idxTree = {NULL, NULL}; i = 1; while (++i < objc) { if (TclListObjGetElements(interp, objv[i], &lstc, &lstv) != TCL_OK) { return TCL_ERROR; |
︙ | ︙ |
Changes to generic/tclStubInit.c.
︙ | ︙ | |||
90 91 92 93 94 95 96 97 98 99 100 101 102 103 | # define TclListObjGetElements 0 # define TclListObjLength 0 # define TclDictObjSize 0 # define TclSplitList 0 # define TclSplitPath 0 # define TclFSSplitPath 0 # define TclParseArgsObjv 0 #else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { | > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | # define TclListObjGetElements 0 # define TclListObjLength 0 # define TclDictObjSize 0 # define TclSplitList 0 # define TclSplitPath 0 # define TclFSSplitPath 0 # define TclParseArgsObjv 0 # define TclGetAliasObj 0 #else /* !defined(TCL_NO_DEPRECATED) */ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr); if (objcPtr) { if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { |
︙ | ︙ | |||
183 184 185 186 187 188 189 190 191 192 193 194 195 196 | int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) { Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); *(int *)objcPtr = (int)n; return result; } #endif /* !defined(TCL_NO_DEPRECATED) */ #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp | > > > > > > > > > > > > > > > > | 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 | int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv) { Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ; int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv); *(int *)objcPtr = (int)n; return result; } int TclGetAliasObj(Tcl_Interp *interp, const char *childCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) { Tcl_Size n = TCL_INDEX_NONE; int result = Tcl_GetAliasObj(interp, childCmd, targetInterpPtr, targetCmdPtr, &n, objv); if (objcPtr) { if ((sizeof(int) != sizeof(Tcl_Size)) && (result == TCL_OK) && (n > INT_MAX)) { if (interp) { Tcl_AppendResult(interp, "List too large to be processed", NULL); } return TCL_ERROR; } *objcPtr = (int)n; } return result; } #endif /* !defined(TCL_NO_DEPRECATED) */ #define TclBN_mp_add mp_add #define TclBN_mp_add_d mp_add_d #define TclBN_mp_and mp_and #define TclBN_mp_clamp mp_clamp |
︙ | ︙ | |||
946 947 948 949 950 951 952 | Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ 0, /* 147 */ | | | | 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 | Tcl_ExprObj, /* 141 */ Tcl_ExprString, /* 142 */ Tcl_Finalize, /* 143 */ 0, /* 144 */ Tcl_FirstHashEntry, /* 145 */ Tcl_Flush, /* 146 */ 0, /* 147 */ 0, /* 148 */ TclGetAliasObj, /* 149 */ Tcl_GetAssocData, /* 150 */ Tcl_GetChannel, /* 151 */ Tcl_GetChannelBufferSize, /* 152 */ Tcl_GetChannelHandle, /* 153 */ Tcl_GetChannelInstanceData, /* 154 */ Tcl_GetChannelMode, /* 155 */ Tcl_GetChannelName, /* 156 */ |
︙ | ︙ | |||
1083 1084 1085 1086 1087 1088 1089 | 0, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ Tcl_UnstackChannel, /* 282 */ Tcl_GetStackedChannel, /* 283 */ Tcl_SetMainLoop, /* 284 */ | | | 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 | 0, /* 278 */ Tcl_GetVersion, /* 279 */ Tcl_InitMemory, /* 280 */ Tcl_StackChannel, /* 281 */ Tcl_UnstackChannel, /* 282 */ Tcl_GetStackedChannel, /* 283 */ Tcl_SetMainLoop, /* 284 */ Tcl_GetAliasObj, /* 285 */ Tcl_AppendObjToObj, /* 286 */ Tcl_CreateEncoding, /* 287 */ Tcl_CreateThreadExitHandler, /* 288 */ Tcl_DeleteThreadExitHandler, /* 289 */ 0, /* 290 */ Tcl_EvalEx, /* 291 */ Tcl_EvalObjv, /* 292 */ |
︙ | ︙ | |||
1486 1487 1488 1489 1490 1491 1492 | Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ Tcl_UtfNcmp, /* 686 */ Tcl_UtfNcasecmp, /* 687 */ | > > | | 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 | Tcl_GetNumber, /* 681 */ Tcl_RemoveChannelMode, /* 682 */ Tcl_GetEncodingNulLength, /* 683 */ Tcl_GetWideUIntFromObj, /* 684 */ Tcl_DStringToObj, /* 685 */ Tcl_UtfNcmp, /* 686 */ Tcl_UtfNcasecmp, /* 687 */ Tcl_NewWideUIntObj, /* 688 */ Tcl_SetWideUIntObj, /* 689 */ TclUnusedStubEntry, /* 690 */ }; /* !END!: Do not edit above this line. */ |
Changes to generic/tclTest.c.
︙ | ︙ | |||
18 19 20 21 22 23 24 | #define TCL_8_API #undef BUILD_tcl #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" | < < < < < | 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | #define TCL_8_API #undef BUILD_tcl #undef STATIC_BUILD #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif #include "tclInt.h" #include "tclOO.h" #include <math.h> /* * Required for Testregexp*Cmd */ #include "tclRegexp.h" |
︙ | ︙ | |||
530 531 532 533 534 535 536 | "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) { return TCL_ERROR; } | < < < < < | 525 526 527 528 529 530 531 532 533 534 535 536 537 538 | "-appinitprocerror", "-appinitprocdeleteinterp", "-appinitprocclosestderr", "-appinitprocsetrcfile", NULL }; if (Tcl_InitStubs(interp, "8.7-", 0) == NULL) { return TCL_ERROR; } if (Tcl_OOInitStubs(interp) == NULL) { return TCL_ERROR; } if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) { #if TCL_MAJOR_VERSION > 8 if (info.isNativeObjectProc == 2) { |
︙ | ︙ | |||
3432 3433 3434 3435 3436 3437 3438 | TclFormatInt(buffer, (int) ushortVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) uintVar); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideIntObj(longVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); | < < < < < < < < < | < < < < < < < | < | 3422 3423 3424 3425 3426 3427 3428 3429 3430 3431 3432 3433 3434 3435 3436 3437 3438 3439 3440 3441 | TclFormatInt(buffer, (int) ushortVar); Tcl_AppendElement(interp, buffer); TclFormatInt(buffer, (int) uintVar); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideIntObj(longVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); tmp = Tcl_NewWideUIntObj(ulongVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); Tcl_PrintDouble(NULL, (double)floatVar, buffer); Tcl_AppendElement(interp, buffer); tmp = Tcl_NewWideUIntObj(uwideVar); Tcl_AppendElement(interp, Tcl_GetString(tmp)); Tcl_DecrRefCount(tmp); } else if (strcmp(argv[1], "set") == 0) { int v; if (argc != 16) { Tcl_AppendResult(interp, "wrong # args: should be \"", |
︙ | ︙ |
Changes to generic/tclTestObj.c.
︙ | ︙ | |||
99 100 101 102 103 104 105 | /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; | > > > > > | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | /* * An array of Tcl_Obj pointers used in the commands that operate on or get * the values of Tcl object-valued variables. varPtr[i] is the i-th variable's * Tcl_Obj *. */ Tcl_Obj **varPtr; #ifndef TCL_WITH_EXTERNAL_TOMMATH if (Tcl_TomMath_InitStubs(interp, "8.7-") == NULL) { return TCL_ERROR; } #endif varPtr = (Tcl_Obj **)Tcl_Alloc(NUMBER_OF_OBJECT_VARS * sizeof(varPtr[0])); if (!varPtr) { return TCL_ERROR; } Tcl_SetAssocData(interp, VARPTR_KEY, VarPtrDeleteProc, varPtr); for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) { varPtr[i] = NULL; } |
︙ | ︙ |
Changes to library/auto.tcl.
︙ | ︙ | |||
303 304 305 306 307 308 309 | set error [catch { set f [open $file] fconfigure $f -encoding utf-8 -eofchar \x1A while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] append index "set [list auto_index($procName)]" | | | 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 | set error [catch { set f [open $file] fconfigure $f -encoding utf-8 -eofchar \x1A while {[gets $f line] >= 0} { if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} { set procName [lindex [auto_qualify $procName "::"] 0] append index "set [list auto_index($procName)]" append index " \[list source -encoding utf-8 \[file join \$dir [list $file]\]\]\n" } } close $f } msg opts] if {$error} { catch {close $f} cd $oldDir |
︙ | ︙ | |||
590 591 592 593 594 595 596 | # the file name that we know about (which will be a proper list, and so # correctly quoted). set name [string range [list \}[fullname $name]] 2 end] set filenameParts [file split $scriptFile] append index [format \ | | | 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 | # the file name that we know about (which will be a proper list, and so # correctly quoted). set name [string range [list \}[fullname $name]] 2 end] set filenameParts [file split $scriptFile] append index [format \ {set auto_index(%s) [list source -encoding utf-8 [file join $dir %s]]%s} \ $name $filenameParts \n] return } if {[llength $::auto_mkindex_parser::initCommands]} { return } |
︙ | ︙ |
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
︙ | ︙ | |||
219 220 221 222 223 224 225 | F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; }; F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; }; F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; }; F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; }; F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; }; F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; }; | | | 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | F93599D80DF1F98300E04F67 /* self.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = self.n; sourceTree = "<group>"; }; F946FB8B0FBE3AED00CD6495 /* itcl */ = {isa = PBXFileReference; lastKnownFileType = folder; path = itcl; sourceTree = "<group>"; }; F95D77E90DFD820D00A8BF6F /* tclIORTrans.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclIORTrans.c; sourceTree = "<group>"; }; F95FAFF90B34F1130072E431 /* macOSXLoad.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = macOSXLoad.test; sourceTree = "<group>"; }; F96437C90EF0D4B2003F468E /* tclZlib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclZlib.c; sourceTree = "<group>"; }; F96437E60EF0D652003F468E /* libz.dylib */ = {isa = PBXFileReference; lastKnownFileType = "compiled.mach-o.dylib"; name = libz.dylib; path = /usr/lib/libz.dylib; sourceTree = "<absolute>"; }; F966C07408F2820D005CB29B /* CoreFoundation.framework */ = {isa = PBXFileReference; lastKnownFileType = wrapper.framework; name = CoreFoundation.framework; path = /System/Library/Frameworks/CoreFoundation.framework; sourceTree = "<absolute>"; }; F96D3DFB08F272A4004A47F5 /* changes.md */ = {isa = PBXFileReference; explicitFileType = text; fileEncoding = 4; path = changes.md; sourceTree = "<group>"; }; F96D3DFD08F272A4004A47F5 /* Access.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Access.3; sourceTree = "<group>"; }; F96D3DFE08F272A4004A47F5 /* AddErrInfo.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AddErrInfo.3; sourceTree = "<group>"; }; F96D3DFF08F272A4004A47F5 /* after.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = after.n; sourceTree = "<group>"; }; F96D3E0008F272A4004A47F5 /* Alloc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = Alloc.3; sourceTree = "<group>"; }; F96D3E0108F272A4004A47F5 /* AllowExc.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AllowExc.3; sourceTree = "<group>"; }; F96D3E0208F272A4004A47F5 /* append.n */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = append.n; sourceTree = "<group>"; }; F96D3E0308F272A4004A47F5 /* AppInit.3 */ = {isa = PBXFileReference; explicitFileType = text.man; fileEncoding = 4; path = AppInit.3; sourceTree = "<group>"; }; |
︙ | ︙ | |||
944 945 946 947 948 949 950 | F96D425C08F272B2004A47F5 /* libtommath */, F96D446E08F272B9004A47F5 /* win */, F96D3F3808F272A7004A47F5 /* library */, F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, F9183E690EFC81560030B814 /* pkgs */, | | | 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 | F96D425C08F272B2004A47F5 /* libtommath */, F96D446E08F272B9004A47F5 /* win */, F96D3F3808F272A7004A47F5 /* library */, F96D434408F272B5004A47F5 /* tests */, F96D3DFC08F272A4004A47F5 /* doc */, F96D43D008F272B8004A47F5 /* tools */, F9183E690EFC81560030B814 /* pkgs */, F96D3DFB08F272A4004A47F5 /* changes.md */, F96D434308F272B5004A47F5 /* README.md */, F96D432B08F272B4004A47F5 /* license.terms */, ); name = "Tcl Sources"; sourceTree = TCL_SRCROOT; }; F96D3DFC08F272A4004A47F5 /* doc */ = { |
︙ | ︙ |
Changes to tests/autoMkindex.test.
︙ | ︙ | |||
121 122 123 124 125 126 127 | file delete tclIndex file exists tclIndex } {0} test autoMkindex-1.2 {build tclIndex based on a test file} { auto_mkindex . autoMkindex.tcl file exists tclIndex } {1} | | | 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | file delete tclIndex file exists tclIndex } {0} test autoMkindex-1.2 {build tclIndex based on a test file} { auto_mkindex . autoMkindex.tcl file exists tclIndex } {1} set element "{source -encoding utf-8 [file join . autoMkindex.tcl]}" test autoMkindex-1.3 {examine tclIndex} -setup { file delete tclIndex } -body { auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index |
︙ | ︙ | |||
186 187 188 189 190 191 192 | test autoMkindex-3.2 {auto_mkindex_parser::command} -setup { file delete tclIndex } -body { auto_mkindex_parser::command buried::myproc {name args} { variable index variable scriptFile append index [list set auto_index([fullname $name])] \ | | | 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 | test autoMkindex-3.2 {auto_mkindex_parser::command} -setup { file delete tclIndex } -body { auto_mkindex_parser::command buried::myproc {name args} { variable index variable scriptFile append index [list set auto_index([fullname $name])] \ " \[list source -encoding utf-8 \[file join \$dir [list $scriptFile]\]\]\n" } auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index source tclIndex set ::result "" |
︙ | ︙ | |||
212 213 214 215 216 217 218 | file delete tclIndex } -constraints {knownBug} -body { auto_mkindex_parser::command {buried::my proc} {name args} { variable index variable scriptFile puts "my proc $name" append index [list set auto_index([fullname $name])] \ | | | 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 | file delete tclIndex } -constraints {knownBug} -body { auto_mkindex_parser::command {buried::my proc} {name args} { variable index variable scriptFile puts "my proc $name" append index [list set auto_index([fullname $name])] \ " \[list source -encoding utf-8 \[file join \$dir [list $scriptFile]\]\]\n" } auto_mkindex . autoMkindex.tcl namespace eval tcl_autoMkindex_tmp { set dir "." variable auto_index source tclIndex set ::result "" |
︙ | ︙ | |||
262 263 264 265 266 267 268 | if {[string match {set auto_index*} $r]} { lappend dat $r } } set result [lsort $dat] close $f set result | | | 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 | if {[string match {set auto_index*} $r]} { lappend dat $r } } set result [lsort $dat] close $f set result } {{set auto_index(::wok::commands) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source -encoding utf-8 [file join $dir ensemblecommands.tcl]]}} removeFile ensemblecommands.tcl test autoMkindex-4.1 {platform independent source commands} -setup { file delete tclIndex makeDirectory pkg makeFile { package provide football 1.0 |
︙ | ︙ | |||
299 300 301 302 303 304 305 | auto_mkindex . pkg/samename.tcl set f [open tclIndex r] lsort [lrange [split [string trim [read $f]] "\n"] end-1 end] } -cleanup { catch {close $f} removeFile [file join pkg samename.tcl] removeDirectory pkg | | | 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 | auto_mkindex . pkg/samename.tcl set f [open tclIndex r] lsort [lrange [split [string trim [read $f]] "\n"] end-1 end] } -cleanup { catch {close $f} removeFile [file join pkg samename.tcl] removeDirectory pkg } -result {{set auto_index(::college::team) [list source -encoding utf-8 [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source -encoding utf-8 [file join $dir pkg samename.tcl]]}} test autoMkindex-5.1 {escape magic tcl chars in general code} -setup { file delete tclIndex makeDirectory pkg makeFile { set dollar1 "this string contains an unescaped dollar sign -> \\$foo" set dollar2 \ |
︙ | ︙ | |||
323 324 325 326 327 328 329 | auto_mkindex . pkg/magicchar.tcl set f [open tclIndex r] lindex [split [string trim [read $f]] "\n"] end } -cleanup { catch {close $f} removeFile [file join pkg magicchar.tcl] removeDirectory pkg | | | 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 | auto_mkindex . pkg/magicchar.tcl set f [open tclIndex r] lindex [split [string trim [read $f]] "\n"] end } -cleanup { catch {close $f} removeFile [file join pkg magicchar.tcl] removeDirectory pkg } -result {set auto_index(testProc) [list source -encoding utf-8 [file join $dir pkg magicchar.tcl]]} test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup { file delete tclIndex makeDirectory pkg makeFile { proc {[magic mojo proc]} {} {} } [file join pkg magicchar2.tcl] set result {} |
︙ | ︙ |
Changes to tests/clock.test.
︙ | ︙ | |||
37028 37029 37030 37031 37032 37033 37034 37035 37036 37037 37038 37039 37040 37041 37042 37043 37044 37045 37046 | set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result {12:34:56-0500} test clock-44.2 {regression test - time zone containing only two digits} \ -body { clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z } \ -result 482134530 test clock-45.1 {compat: scan regression on spaces (multiple spaces in format)} \ -body { list \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ | > > > > > > > > > > > > > > | 37028 37029 37030 37031 37032 37033 37034 37035 37036 37037 37038 37039 37040 37041 37042 37043 37044 37045 37046 37047 37048 37049 37050 37051 37052 37053 37054 37055 37056 37057 37058 37059 37060 | set env(TZ) $oldTZ unset oldTZ } else { unset env(TZ) } } \ -result {12:34:56-0500} test clock-44.2 {regression test - time zone containing only two digits} \ -body { clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z } \ -result 482134530 test clock-44.3 {regression test - spaces between some scan tokens are optional (TCL_CLOCK_FULL_COMPAT, no-strict only)} \ -body { list [clock scan {9 Apr 2024} -format {%d %b%Y} -gmt 1] \ [clock scan {Tue, 9 Apr 2024 00:00:00 +0000} -format {%a, %d %b%Y %H:%M:%S %Z} -gmt 1] } \ -result {1712620800 1712620800} test clock-44.4 {regression test - spaces between all scan tokens are optional (TCL_CLOCK_FULL_COMPAT, no-strict only)} \ -body { list [clock scan {9 Apr 2024} -format {%d%b%Y} -gmt 1] \ [clock scan {Tue, 9 Apr 2024 00:00:00 +0000} -format {%a,%d%b%Y%H:%M:%S%Z} -gmt 1] } \ -result {1712620800 1712620800} test clock-45.1 {compat: scan regression on spaces (multiple spaces in format)} \ -body { list \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ [clock scan "11/08/2018 0612" -format "%m/%d/%Y %H%M" -gmt 1] \ |
︙ | ︙ |
Changes to unix/Makefile.in.
︙ | ︙ | |||
2335 2336 2337 2338 2339 2340 2341 | $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix $(INSTALL_DATA_DIR) $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic | | | 2335 2336 2337 2338 2339 2340 2341 2342 2343 2344 2345 2346 2347 2348 2349 | $(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix $(DIST_INSTALL_SCRIPT) $(UNIX_DIR)/configure $(UNIX_DIR)/ldAix $(DISTDIR)/unix $(INSTALL_DATA_DIR) $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/*.decls $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/README $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(GENERIC_DIR)/tclGetDate.y $(DISTDIR)/generic $(DIST_INSTALL_DATA) $(TOP_DIR)/changes.md $(TOP_DIR)/README.md \ $(TOP_DIR)/license.terms $(DISTDIR) $(INSTALL_DATA_DIR) $(DISTDIR)/library $(DIST_INSTALL_DATA) $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \ $(TOP_DIR)/library/manifest.txt \ $(TOP_DIR)/library/tclIndex $(DISTDIR)/library @for i in $(BUILTIN_PACKAGE_LIST); do \ $(INSTALL_DATA_DIR) $(DISTDIR)/library/$$i;\ |
︙ | ︙ |