Tcl Source Code

Check-in [db112bb527]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Revert [d874801c57]: putting back "string bytelength". It turns out to be too complicated to take along with the other deprecations in TIP #485
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-485
Files: files | file ages | folders
SHA3-256:db112bb5272dc834c61ea1a07145a30a51f324a4a7348be0097f794e6f4432d1
User & Date: jan.nijtmans 2017-11-21 09:13:08
Context
2017-11-21
09:48
deprecate VOID/CHAR/SHORT/LONG (windows-only) as well. check-in: a52017885a user: jan.nijtmans tags: tip-485
09:13
Revert [d874801c57]: putting back "string bytelength". It turns out to be too complicated to take a... check-in: db112bb527 user: jan.nijtmans tags: tip-485
2017-11-20
16:26
Deprecate support for macro's like CONST, CONST84, _ANSI_ARGS_, INLINE, TCL_VARARGS check-in: ad7a53a680 user: jan.nijtmans tags: tip-485
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/string.n.

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
Java's serialization mechanism) to enable basic processing with
non-Unicode-aware C functions.  As this representation should only
ever be used by Tcl's implementation, the number of bytes used to
store the representation is of very low value (except to C extension
code, which has direct access for the purpose of memory management,
etc.)
.PP
\fICompatibility note:\fR this subcommand will be gone in
Tcl 9.0. It is better to use the
\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
.PP
.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE







|
|







382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
Java's serialization mechanism) to enable basic processing with
non-Unicode-aware C functions.  As this representation should only
ever be used by Tcl's implementation, the number of bytes used to
store the representation is of very low value (except to C extension
code, which has direct access for the purpose of memory management,
etc.)
.PP
\fICompatibility note:\fR it is likely that this subcommand will be
withdrawn in a future version of Tcl. It is better to use the
\fBencoding convertto\fR command to convert a string to a known
encoding and then apply \fBstring length\fR to that.
.PP
.CS
\fBstring length\fR [encoding convertto utf-8 $theString]
.CE
.RE

Changes to generic/tclCmdMZ.c.

2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
....
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
....
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static int
StringBytesCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
................................................................................
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
    return TCL_OK;
}
#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
 
/*
 *----------------------------------------------------------------------
 *
 * StringLenCmd --
 *
 *	This procedure is invoked to process the "string length" Tcl command.
................................................................................
 */

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
#endif
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},







<







 







<







 







<

<







2889
2890
2891
2892
2893
2894
2895

2896
2897
2898
2899
2900
2901
2902
....
2907
2908
2909
2910
2911
2912
2913

2914
2915
2916
2917
2918
2919
2920
....
3364
3365
3366
3367
3368
3369
3370

3371

3372
3373
3374
3375
3376
3377
3378
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
StringBytesCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
................................................................................
	return TCL_ERROR;
    }

    (void) TclGetStringFromObj(objv[1], &length);
    Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
    return TCL_OK;
}

 
/*
 *----------------------------------------------------------------------
 *
 * StringLenCmd --
 *
 *	This procedure is invoked to process the "string length" Tcl command.
................................................................................
 */

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {

	{"bytelength",	StringBytesCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},

	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},

Changes to library/init.tcl.

275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
		# Compute stack trace contribution from the [uplevel].
		# Note the dependence on how Tcl_AddErrorInfo, etc.
		# construct the stack trace.
		#
		set errInfo [dict get $opts -errorinfo]
		set errCode [dict get $opts -errorcode]
		set cinfo $args
		if {[string length $cinfo] > 150} {
		    set cinfo [string range $cinfo 0 150]
		    while {[string length $cinfo] > 150} {
			set cinfo [string range $cinfo 0 end-1]
		    }
		    append cinfo ...
		}
		set tail "\n    (\"uplevel\" body line 1)\n    invoked\
			from within\n\"uplevel 1 \$args\""
		set expect "$msg\n    while executing\n\"$cinfo\"$tail"







|

|







275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
		# Compute stack trace contribution from the [uplevel].
		# Note the dependence on how Tcl_AddErrorInfo, etc.
		# construct the stack trace.
		#
		set errInfo [dict get $opts -errorinfo]
		set errCode [dict get $opts -errorcode]
		set cinfo $args
		if {[string bytelength $cinfo] > 150} {
		    set cinfo [string range $cinfo 0 150]
		    while {[string bytelength $cinfo] > 150} {
			set cinfo [string range $cinfo 0 end-1]
		    }
		    append cinfo ...
		}
		set tail "\n    (\"uplevel\" body line 1)\n    invoked\
			from within\n\"uplevel 1 \$args\""
		set expect "$msg\n    while executing\n\"$cinfo\"$tail"

Changes to tests/info.test.

99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
    eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
    proc foo args [list subst bar]
    list [string length [info body foo]] \
	    [foo; string length [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    expr {$z-$x}







|
|







99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
    eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
    proc foo args [list subst bar]
    list [string bytelength [info body foo]] \
	    [foo; string bytelength [info body foo]]
} {9 9}

proc testinfocmdcount {} {
    set x [info cmdcount]
    set y 12345
    set z [info cm]
    expr {$z-$x}

Changes to tests/regexp.test.

756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771

test regexp-20.1 {regsub shared object shimmering} {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz
    set b $a
    set c abcdefghijklmnopqurstuvwxyz0123456789
    regsub $a $c $b d
    list $d [string length $d]
} [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexp-20.2 {regsub shared object shimmering with -about} {
    eval regexp -about abc
} {0 {}}

test regexp-21.1 {regsub works with empty string} {
    regsub -- ^ {} foo
} {foo}







|
|







756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771

test regexp-20.1 {regsub shared object shimmering} {
    # Bug #461322
    set a abcdefghijklmnopqurstuvwxyz
    set b $a
    set c abcdefghijklmnopqurstuvwxyz0123456789
    regsub $a $c $b d
    list $d [string length $d] [string bytelength $d]
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexp-20.2 {regsub shared object shimmering with -about} {
    eval regexp -about abc
} {0 {}}

test regexp-21.1 {regsub works with empty string} {
    regsub -- ^ {} foo
} {foo}

Changes to tests/regexpComp.test.

794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz
	set b $a
	set c abcdefghijklmnopqurstuvwxyz0123456789
	regsub $a $c $b d
	list $d [string length $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }
} {0 {}}

test regexpComp-21.1 {regexp command compiling tests} {







|

|







794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
test regexpComp-20.1 {regsub shared object shimmering} {
    evalInProc {
	# Bug #461322
	set a abcdefghijklmnopqurstuvwxyz
	set b $a
	set c abcdefghijklmnopqurstuvwxyz0123456789
	regsub $a $c $b d
	list $d [string length $d] [string bytelength $d]
    }
} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37]
test regexpComp-20.2 {regsub shared object shimmering with -about} {
    evalInProc {
	eval regexp -about abc
    }
} {0 {}}

test regexpComp-21.1 {regexp command compiling tests} {