Tcl Source Code

Check-in [d3b73e481b]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: d3b73e481be9df24537b5c6b2a5e2342282b2846
User & Date: jan.nijtmans 2017-06-23 15:05:44
Context
2017-06-26
20:13
merge trunk check-in: 80be23dd56 user: dgp tags: novem
2017-06-23
15:05
merge trunk check-in: d3b73e481b user: jan.nijtmans tags: novem
15:04
No longer split tests for longIs32bit/longIs64bit, since the results should be identical check-in: a7db1ba444 user: jan.nijtmans tags: trunk
09:14
Merge trunk (but without %#d format, pending further decision and bug-fixing) check-in: 818930fdcd user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/regsub.n.

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
and
.QW \e\fIn\fR
sequences are handled for each substitution using the information
from the corresponding match.
.TP
\fB\-command\fR
.VS 8.7
Changes the handling of the substitution string so that it no longer treats

.QW &
and
.QW \e
as special characters, but instead uses them as a non-empty list of words.
Each time a substitution is processed, another complete Tcl word is appended
to that list for each substitution value (the first such argument represents
the overall matched substring, the subsequent arguments will be one per
capturing sub-RE, much as are returned from \fBregexp\fR \fB\-inline\fR) and


the overall list is then evaluated as a Tcl command call. If the command
finishes successfully, the result of command call is substituted into the
resulting string.

.RS
.PP
If \fB\-all\fR is not also given, the command callback will be invoked at most
once (exactly when the regular expression matches). If \fB\-all\fR is given,
the command callback will be invoked for each matched location, in sequence.
The exact location indices that matched are not made available to the script.
.PP







|
>


|
|
<
|
|
|
>
>
|
<
|
>







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
and
.QW \e\fIn\fR
sequences are handled for each substitution using the information
from the corresponding match.
.TP
\fB\-command\fR
.VS 8.7
Changes the handling of \fIsubSpec\fR so that it is not treated
as a template for a substitution string and the substrings
.QW &
and
.QW \e\fIn\fR
no longer have special meaning. Instead \fIsubSpec\fR must be a

command prefix, that is, a non-empty list.  The substring of \fIstring\fR
that matches \fIexp\fR, and then each substring that matches each
capturing sub-RE within \fIexp\fR are appended as additional elements
to that list. (The items appended to the list are much like what
\fBregexp\fR \fB-inline\fR would return).  The completed list is then
evaluated as a Tcl command, and the result of that command is the

substitution string.  Any error or exception from command evaluation
becomes an error or exception from the \fBregsub\fR command.
.RS
.PP
If \fB\-all\fR is not also given, the command callback will be invoked at most
once (exactly when the regular expression matches). If \fB\-all\fR is given,
the command callback will be invoked for each matched location, in sequence.
The exact location indices that matched are not made available to the script.
.PP

Changes to generic/tclCmdMZ.c.

483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
    int start, end, subStart, subEnd, match, command, numParts, numArgs;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
    Tcl_Obj **args = NULL, **parts;
    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
	"--",		NULL
    };







|



<







483
484
485
486
487
488
489
490
491
492
493

494
495
496
497
498
499
500
Tcl_RegsubObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
    int start, end, subStart, subEnd, match, command, numParts;
    Tcl_RegExp regExpr;
    Tcl_RegExpInfo info;
    Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;

    Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;

    static const char *const options[] = {
	"-all",		"-command",	"-expanded",	"-line",
	"-linestop",	"-lineanchor",	"-nocase",	"-start",
	"--",		NULL
    };
769
770
771
772
773
774
775


776
777
778
779
780
781
782
783
784
785
786
787
788
	 * In command-prefix mode, the substitutions are added as quoted
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	if (command) {


	    if (args == NULL) {
		Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
		numArgs = numParts + info.nsubs + 1;
		args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
		memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
	    }

	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);







>
>
|
|
|
|
|
<







768
769
770
771
772
773
774
775
776
777
778
779
780
781

782
783
784
785
786
787
788
	 * In command-prefix mode, the substitutions are added as quoted
	 * arguments to the subSpec to form a command, that is then executed
	 * and the result used as the string to substitute in. Actually,
	 * everything is passed through Tcl_EvalObjv, as that's much faster.
	 */

	if (command) {
	    Tcl_Obj **args = NULL, **parts;
	    int numArgs;

	    Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
	    numArgs = numParts + info.nsubs + 1;
	    args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
	    memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);


	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		subStart = info.matches[idx].start;
		subEnd = info.matches[idx].end;
		if ((subStart >= 0) && (subEnd >= 0)) {
		    args[idx + numParts] = Tcl_NewUnicodeObj(
			    wstring + offset + subStart, subEnd - subStart);
796
797
798
799
800
801
802
803
804
805
806
807
808
809

810
811
812
813
814
815
816
	     * At this point, we're locally holding the references to the
	     * argument words we added for this time round the loop, and the
	     * subPtr is holding the references to the words that the user
	     * supplied directly. None are zero-refcount, which is important
	     * because Tcl_EvalObjv is "hairy monster" in terms of refcount
	     * handling, being able to optionally add references to any of its
	     * argument words. We'll drop the local refs immediately
	     * afterwarsds; subPtr is handled in the main exit stanza.
	     */

	    result = Tcl_EvalObjv(interp, numArgs, args, 0);
	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		TclDecrRefCount(args[idx + numParts]);
	    }

	    if (result != TCL_OK) {
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (%s substitution computation script)",
			    options[REGSUB_COMMAND]));
		}
		goto done;







|






>







796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
	     * At this point, we're locally holding the references to the
	     * argument words we added for this time round the loop, and the
	     * subPtr is holding the references to the words that the user
	     * supplied directly. None are zero-refcount, which is important
	     * because Tcl_EvalObjv is "hairy monster" in terms of refcount
	     * handling, being able to optionally add references to any of its
	     * argument words. We'll drop the local refs immediately
	     * afterwards; subPtr is handled in the main exit stanza.
	     */

	    result = Tcl_EvalObjv(interp, numArgs, args, 0);
	    for (idx = 0 ; idx <= info.nsubs ; idx++) {
		TclDecrRefCount(args[idx + numParts]);
	    }
	    ckfree(args);
	    if (result != TCL_OK) {
		if (result == TCL_ERROR) {
		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
			    "\n    (%s substitution computation script)",
			    options[REGSUB_COMMAND]));
		}
		goto done;
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
  done:
    if (objPtr && (objv[1] == objv[0])) {
	Tcl_DecrRefCount(objPtr);
    }
    if (subPtr && (objv[2] == objv[0])) {
	Tcl_DecrRefCount(subPtr);
    }
    if (args) {
	ckfree(args);
    }
    if (resultPtr) {
	Tcl_DecrRefCount(resultPtr);
    }
    return result;
}

/*







<
<
<







972
973
974
975
976
977
978



979
980
981
982
983
984
985
  done:
    if (objPtr && (objv[1] == objv[0])) {
	Tcl_DecrRefCount(objPtr);
    }
    if (subPtr && (objv[2] == objv[0])) {
	Tcl_DecrRefCount(subPtr);
    }



    if (resultPtr) {
	Tcl_DecrRefCount(resultPtr);
    }
    return result;
}

/*