Tcl Source Code

Changes On Branch tip-651
Login

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

Changes In Branch tip-651 Excluding Merge-Ins

This is equivalent to a diff from cfa529ea81 to daadbbf337

2022-11-20
17:38
Merge 8.6. TIP #651 implementation (since there are already 2 YES votes, no NO votes expected) check-in: 4218e66972 user: jan.nijtmans tags: core-8-branch
2022-11-17
11:18
doc update check-in: b564f03217 user: jan.nijtmans tags: core-8-branch
04:54
TIP 651 implementation Closed-Leaf check-in: daadbbf337 user: apnadkarni tags: tip-651
03:54
Merge 8.7 - reserve stub entry 687 check-in: 2166c1e9e1 user: apnadkarni tags: trunk, main
03:52
Reserve stub entry 687 for TIP #651 check-in: cfa529ea81 user: apnadkarni tags: core-8-branch
2022-11-16
09:37
http 2.10a4 -> 2.10b1, for upcoming release check-in: 4649724d42 user: jan.nijtmans tags: core-8-branch

Changes to doc/DString.3.

37
38
39
40
41
42
43




44
45
46
47
48
49
50
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54







+
+
+
+







\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR)
.sp
\fBTcl_DStringFree\fR(\fIdsPtr\fR)
.sp
\fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR)
.sp
\fBTcl_DStringGetResult\fR(\fIinterp, dsPtr\fR)
.sp
Tcl_Obj *
\fBTcl_DStringToObj\fR(\fIdsPtr\fR)
.sp
.SH ARGUMENTS
.AS Tcl_DString newLength in/out
.AP Tcl_DString *dsPtr in/out
Pointer to structure that is used to manage a dynamic string.
.AP "const char" *bytes in
Pointer to characters to append to dynamic string.
.AP "const char" *element in
138
139
140
141
142
143
144



145
146
147
148
149
150










151
152
153
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







+
+
+






+
+
+
+
+
+
+
+
+
+



.PP
\fBTcl_DStringResult\fR sets the result of \fIinterp\fR to the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to the interpreter's result.
This saves the cost of allocating new memory and copying the string.
\fBTcl_DStringResult\fR also reinitializes the dynamic string to
an empty string.
Since the dynamic string is reinitialized, there is no need to
further call \fBTcl_DStringFree\fR on it and it can be reused without
calling \fBTcl_DStringInit\fR.
.PP
\fBTcl_DStringGetResult\fR does the opposite of \fBTcl_DStringResult\fR.
It sets the value of \fIdsPtr\fR to the result of \fIinterp\fR and
it clears \fIinterp\fR's result.
If possible it does this by moving a pointer rather than by copying
the string.
.PP
\fBTcl_DStringToObj\fR returns a \fBTcl_Obj\fR containing the value of
the dynamic string given by \fIdsPtr\fR.  It does this by moving
a pointer from \fIdsPtr\fR to a newly allocated \fBTcl_Obj\fR
and reinitializing to dynamic string to an empty string.
This saves the cost of allocating new memory and copying the string.
Since the dynamic string is reinitialized, there is no need to
further call \fBTcl_DStringFree\fR on it and it can be reused without
calling \fBTcl_DStringInit\fR.
The returned \fBTcl_Obj\fR has a reference count of 0.

.SH KEYWORDS
append, dynamic string, free, result

Changes to generic/tcl.decls.

2562
2563
2564
2565
2566
2567
2568
2569
2570
2571



2572

2573
2574
2575
2576
2577
2578
2579
2562
2563
2564
2565
2566
2567
2568



2569
2570
2571

2572
2573
2574
2575
2576
2577
2578
2579







-
-
-
+
+
+
-
+








# TIP #650 (reserved)
#declare 686 {
#    int Tcl_GetWideUIntFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
#	    Tcl_WideUInt *uwidePtr)
#}

# TIP 651 (reserved)
#declare 687 {
#    Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr)
# TIP 651
declare 687 {
    Tcl_Obj *Tcl_DStringToObj(Tcl_DString *dsPtr)
#}
}

# ----- BASELINE -- FOR -- 8.7.0 / 9.0.0 ----- #

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

Changes to generic/tclDecls.h.

2036
2037
2038
2039
2040
2041
2042





2043
2044
2045
2046
2047
2048
2049
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054







+
+
+
+
+







				size_t numBytes, void **clientDataPtr,
				int *typePtr);
/* 682 */
EXTERN int		Tcl_RemoveChannelMode(Tcl_Interp *interp,
				Tcl_Channel chan, int mode);
/* 683 */
EXTERN int		Tcl_GetEncodingNulLength(Tcl_Encoding encoding);
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* Slot 686 is reserved */
/* 687 */
EXTERN Tcl_Obj *	Tcl_DStringToObj(Tcl_DString *dsPtr);

typedef struct {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

2755
2756
2757
2758
2759
2760
2761




2762
2763
2764
2765
2766
2767
2768
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777







+
+
+
+







    Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, Tcl_Size level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */
    Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */
    int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */
    int (*tcl_GetNumberFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void **clientDataPtr, int *typePtr); /* 680 */
    int (*tcl_GetNumber) (Tcl_Interp *interp, const char *bytes, size_t numBytes, void **clientDataPtr, int *typePtr); /* 681 */
    int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 682 */
    int (*tcl_GetEncodingNulLength) (Tcl_Encoding encoding); /* 683 */
    void (*reserved684)(void);
    void (*reserved685)(void);
    void (*reserved686)(void);
    Tcl_Obj * (*tcl_DStringToObj) (Tcl_DString *dsPtr); /* 687 */
} TclStubs;

extern const TclStubs *tclStubsPtr;

#ifdef __cplusplus
}
#endif
4153
4154
4155
4156
4157
4158
4159





4160
4161
4162
4163
4164
4165
4166
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180







+
+
+
+
+







	(tclStubsPtr->tcl_GetNumberFromObj) /* 680 */
#define Tcl_GetNumber \
	(tclStubsPtr->tcl_GetNumber) /* 681 */
#define Tcl_RemoveChannelMode \
	(tclStubsPtr->tcl_RemoveChannelMode) /* 682 */
#define Tcl_GetEncodingNulLength \
	(tclStubsPtr->tcl_GetEncodingNulLength) /* 683 */
/* Slot 684 is reserved */
/* Slot 685 is reserved */
/* Slot 686 is reserved */
#define Tcl_DStringToObj \
	(tclStubsPtr->tcl_DStringToObj) /* 687 */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TclUnusedStubEntry
#if defined(USE_TCL_STUBS)

Changes to generic/tclInt.h.

3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3124
3125
3126
3127
3128
3129
3130

3131
3132
3133
3134
3135
3136
3137







-







			    void *clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    void *clientData);
MODULE_SCOPE char *	TclDStringAppendObj(Tcl_DString *dsPtr,
			    Tcl_Obj *objPtr);
MODULE_SCOPE char *	TclDStringAppendDString(Tcl_DString *dsPtr,
			    Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
4942
4943
4944
4945
4946
4947
4948


4949
4950
4951
4952
4953
4954
4955
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956







+
+







 * MODULE_SCOPE void   TclDStringClear(Tcl_DString *dsPtr);
 */

#define TclDStringAppendLiteral(dsPtr, sLiteral) \
    Tcl_DStringAppend((dsPtr), (sLiteral), sizeof(sLiteral "") - 1)
#define TclDStringClear(dsPtr) \
    Tcl_DStringSetLength((dsPtr), 0)
/* Backward compatibility for TclDStringToObj which is now exported */
#define TclDStringToObj Tcl_DStringToObj

/*
 *----------------------------------------------------------------
 * Macros used by the Tcl core to test for some special double values.
 * (deprecated) The ANSI C "prototypes" for these macros are:
 *
 * MODULE_SCOPE int	TclIsInfinite(double d);

Changes to generic/tclStubInit.c.

2051
2052
2053
2054
2055
2056
2057




2058
2059
2060
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064







+
+
+
+



    Tcl_CreateObjTrace2, /* 677 */
    Tcl_NRCreateCommand2, /* 678 */
    Tcl_NRCallObjProc2, /* 679 */
    Tcl_GetNumberFromObj, /* 680 */
    Tcl_GetNumber, /* 681 */
    Tcl_RemoveChannelMode, /* 682 */
    Tcl_GetEncodingNulLength, /* 683 */
    0, /* 684 */
    0, /* 685 */
    0, /* 686 */
    Tcl_DStringToObj, /* 687 */
};

/* !END!: Do not edit above this line. */

Changes to generic/tclTest.c.

1930
1931
1932
1933
1934
1935
1936





1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953


1954
1955
1956
1957
1958
1959
1960
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956


1957
1958
1959
1960
1961
1962
1963
1964
1965







+
+
+
+
+















-
-
+
+







	}
	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_DStringLength(&dstring)));
    } else if (strcmp(argv[1], "result") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringResult(interp, &dstring);
    } else if (strcmp(argv[1], "toobj") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_SetObjResult(interp, Tcl_DStringToObj(&dstring));
    } else if (strcmp(argv[1], "trunc") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
	    return TCL_ERROR;
	}
	Tcl_DStringSetLength(&dstring, count);
    } else if (strcmp(argv[1], "start") == 0) {
	if (argc != 2) {
	    goto wrongNumArgs;
	}
	Tcl_DStringStartSublist(&dstring);
    } else {
	Tcl_AppendResult(interp, "bad option \"", argv[1],
		"\": must be append, element, end, free, get, length, "
		"result, trunc, or start", NULL);
		"\": must be append, element, end, free, get, gresult, length, "
		"result, start, toobj, or trunc", NULL);
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 * The procedure below is used as a special freeProc to test how well

Changes to generic/tclUtil.c.

3103
3104
3105
3106
3107
3108
3109
3110

3111
3112
3113
3114
3115
3116
3117
3103
3104
3105
3106
3107
3108
3109

3110
3111
3112
3113
3114
3115
3116
3117







-
+







 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDStringToObj(
Tcl_DStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->string == dsPtr->staticSpace) {
	if (dsPtr->length == 0) {
	    TclNewObj(result);

Changes to tests/dstring.test.

469
470
471
472
473
474
475







































476
477
478
479
480
481
482
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







    set result {}
    lappend result [testdstring gresult special]
    testdstring append z 1
    lappend result [testdstring get]
} -cleanup {
    testdstring free
} -result {{} {This is a specially-allocated stringz}}

test dstring-7.1 {copying to Tcl_Obj} -constraints testdstring -setup {
    testdstring free
} -body {
    testdstring append xyz -1
    list [testdstring toobj] [testdstring length]
} -cleanup {
    testdstring free
} -result {xyz 0}
test dstring-7.2 {copying to a Tcl_Obj} -constraints testdstring -setup {
    testdstring free
    unset -nocomplain a
} -body {
    foreach l {a b c d e f g h i j k l m n o p} {
	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
    }
    set a [testdstring toobj]
    testdstring append abc -1
    list $a [testdstring get]
} -cleanup {
    testdstring free
} -result {{aaaaaaaaaaaaaaaaaaaaa
bbbbbbbbbbbbbbbbbbbbb
ccccccccccccccccccccc
ddddddddddddddddddddd
eeeeeeeeeeeeeeeeeeeee
fffffffffffffffffffff
ggggggggggggggggggggg
hhhhhhhhhhhhhhhhhhhhh
iiiiiiiiiiiiiiiiiiiii
jjjjjjjjjjjjjjjjjjjjj
kkkkkkkkkkkkkkkkkkkkk
lllllllllllllllllllll
mmmmmmmmmmmmmmmmmmmmm
nnnnnnnnnnnnnnnnnnnnn
ooooooooooooooooooooo
ppppppppppppppppppppp
} abc}


# cleanup
if {[testConstraint testdstring]} {
    testdstring free
}
::tcltest::cleanupTests
return