Tcl Source Code

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

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

Overview
Comment:Merge 8.4; Tag for release.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-4-20-rc | rc1
Files: files | file ages | folders
SHA1: 6c8196ee303f87aee747f6ff6a7f300d89994270
User & Date: dgp 2013-04-17 15:31:56
Context
2013-05-14
18:15
merge 8.4 check-in: 56ca4b0f4e user: dgp tags: core-8-4-20-rc, rc2
2013-04-17
15:31
Merge 8.4; Tag for release. check-in: 6c8196ee30 user: dgp tags: core-8-4-20-rc, rc1
2013-04-12
11:08
Implement Tcl_Pkg* functions as macro's around Tcl_Pkg*Ex. This saves stack space, is (marginally) f... check-in: 71773cb9e6 user: jan.nijtmans tags: core-8-4-branch
2013-03-26
14:00
Tag for release. check-in: fbb5b2b97b user: dgp tags: core-8-4-20-rc, rc0
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to .fossil-settings/ignore-glob.

14
15
16
17
18
19
20



21
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
unix/dltest.marker



win/tcl.hpj






>
>
>

14
15
16
17
18
19
20
21
22
23
24
*/config.log
*/config.status
*/tclConfig.sh
*/tclsh*
*/tcltest*
*/versions.vc
unix/dltest.marker
unix/tcl.pc
unix/pkgs/*
win/pkgs/*
win/tcl.hpj

Changes to ChangeLog.

1
2
3
4
5
6
7
8
..
10
11
12
13
14
15
16














17
18
19
20
21
22
23
2013-03-26  Don Porter  <[email protected]>

	*** 8.4.20 TAGGED FOR RELEASE ***

	* README:		Bump version number to 8.4.20
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
................................................................................
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.13
	* win/configure:

	* changes:		updates for 8.4.20 release.















2013-03-19  Don Porter  <[email protected]>

	* generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result.

2013-03-19  Jan Nijtmans  <[email protected]>

|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
..
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
2013-06-01  Don Porter  <[email protected]>

	*** 8.4.20 TAGGED FOR RELEASE ***

	* README:		Bump version number to 8.4.20
	* generic/tcl.h:
	* tools/tcl.wse.in:
	* unix/configure.in:
................................................................................
	* win/README.binary:
	* win/configure.in:

	* unix/configure:	autoconf-2.13
	* win/configure:

	* changes:		updates for 8.4.20 release.

2013-04-09  Reinhard Max  <[email protected]>

	* library/http/http.tcl (http::geturl): Allow URLs that don't have
	a path, but a query query, e.g. http://example.com?foo=bar .
	* Bump the http package to 2.5.8.

2013-04-08  Don Porter  <[email protected]>

	* generic/regc_color.c:	[Bug 3610026] Stop crash when the number of
	* generic/regerrs.h:	"colors" in a regular expression overflows
	* generic/regex.h:	a short int.  Thanks to Heikki Linnakangas
	* generic/regguts.h:	for the report and the patch.
	* tests/regexp.test:

2013-03-19  Don Porter  <[email protected]>

	* generic/tclFCmd.c: [Bug 3597000] Consistent [file copy] result.

2013-03-19  Jan Nijtmans  <[email protected]>

Changes to changes.

6625
6626
6627
6628
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
....
6668
6669
6670
6671
6672
6673
6674





6675
6676
6677
6678
2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer)

2012-02-09 (bug fix)[3484402] mem corrupt OBOE in unicode append (porter)

2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)

2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)
=> http 2.5.7

2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)
=> dde 1.2.5

2012-06-29 (enhancement) Add tn, ro_MO, ru_MO to msgcat (nijtmans)
=> msgcat 1.3.5

................................................................................

2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
(grathwohl,lane,porter)

2013-03-12 (enhancement) better build support for Debian arch (shadura)

2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)






New package: platform 1.0.11

--- Released 8.4.20, June 1, 2013 --- See ChangeLog for details ---






<







 







>
>
>
>
>




6625
6626
6627
6628
6629
6630
6631

6632
6633
6634
6635
6636
6637
6638
....
6667
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
2012-02-06 (bug fix)[3484621] bump bytecode epoch on exec traces (kuhn,sofer)

2012-02-09 (bug fix)[3484402] mem corrupt OBOE in unicode append (porter)

2012-02-29 (bug fix)[3466099] BOM in Unicode (nijtmans)

2012-03-07 (bug fix)[3498327] RFC 3986 compliance (kupries)


2012-05-10 (bug fix)[473946] correct send of special characters (nijtmans)
=> dde 1.2.5

2012-06-29 (enhancement) Add tn, ro_MO, ru_MO to msgcat (nijtmans)
=> msgcat 1.3.5

................................................................................

2013-03-06 (bug fix)[3606683] [regexp (((((a)*)*)*)*)* {}] hangs
(grathwohl,lane,porter)

2013-03-12 (enhancement) better build support for Debian arch (shadura)

2013-03-19 (bug fix)[2893771] [file stat] on locked files (thoyts,nijtmans)

2013-04-08 (bug fix)[3610026] regexp surplus colors crash (linnakangas)

2013-04-09 (bug fix) Allow http://example.com?foo=bar (max)
=> http 2.5.8

New package: platform 1.0.11

--- Released 8.4.20, June 1, 2013 --- See ChangeLog for details ---

Changes to generic/regc_color.c.

219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
...
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
 ^ static color newcolor(struct colormap *);
 */
static color			/* COLORLESS for error */
newcolor(cm)
struct colormap *cm;
{
	struct colordesc *cd;
	struct colordesc *new;
	size_t n;

	if (CISERR())
		return COLORLESS;

	if (cm->free != 0) {
		assert(cm->free > 0);
................................................................................
		assert(cd->arcs == NULL);
		cm->free = cd->sub;
	} else if (cm->max < cm->ncds - 1) {
		cm->max++;
		cd = &cm->cd[cm->max];
	} else {
		/* oops, must allocate more */






		n = cm->ncds * 2;


		if (cm->cd == cm->cdspace) {
			new = (struct colordesc *)MALLOC(n *
						sizeof(struct colordesc));
			if (new != NULL)
				memcpy(VS(new), VS(cm->cdspace), cm->ncds *
						sizeof(struct colordesc));
		} else
			new = (struct colordesc *)REALLOC(cm->cd,
						n * sizeof(struct colordesc));
		if (new == NULL) {
			CERR(REG_ESPACE);
			return COLORLESS;
		}
		cm->cd = new;
		cm->ncds = n;
		assert(cm->max < cm->ncds - 1);
		cm->max++;
		cd = &cm->cd[cm->max];
	}

	cd->nchrs = 0;






<







 







>
>
>
>
>
>

>
>

|

|
|


|

|



|







219
220
221
222
223
224
225

226
227
228
229
230
231
232
...
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
 ^ static color newcolor(struct colormap *);
 */
static color			/* COLORLESS for error */
newcolor(cm)
struct colormap *cm;
{
	struct colordesc *cd;

	size_t n;

	if (CISERR())
		return COLORLESS;

	if (cm->free != 0) {
		assert(cm->free > 0);
................................................................................
		assert(cd->arcs == NULL);
		cm->free = cd->sub;
	} else if (cm->max < cm->ncds - 1) {
		cm->max++;
		cd = &cm->cd[cm->max];
	} else {
		/* oops, must allocate more */
		struct colordesc *newCd;

		if (cm->max == MAX_COLOR) {
			CERR(REG_ECOLORS);
			return COLORLESS;	/* too many colors */
		}
		n = cm->ncds * 2;
		if (n < MAX_COLOR + 1)
			n = MAX_COLOR + 1;
		if (cm->cd == cm->cdspace) {
			newCd = (struct colordesc *)MALLOC(n *
						sizeof(struct colordesc));
			if (newCd != NULL)
				memcpy(VS(newCd), VS(cm->cdspace), cm->ncds *
						sizeof(struct colordesc));
		} else
			newCd = (struct colordesc *)REALLOC(cm->cd,
						n * sizeof(struct colordesc));
		if (newCd == NULL) {
			CERR(REG_ESPACE);
			return COLORLESS;
		}
		cm->cd = newCd;
		cm->ncds = n;
		assert(cm->max < cm->ncds - 1);
		cm->max++;
		cd = &cm->cd[cm->max];
	}

	cd->nchrs = 0;

Changes to generic/regerrs.h.

13
14
15
16
17
18
19

{ REG_ESPACE,	"REG_ESPACE",	"out of memory" },
{ REG_BADRPT,	"REG_BADRPT",	"quantifier operand invalid" },
{ REG_ASSERT,	"REG_ASSERT",	"\"can't happen\" -- you found a bug" },
{ REG_INVARG,	"REG_INVARG",	"invalid argument to regex function" },
{ REG_MIXED,	"REG_MIXED",	"character widths of regex and string differ" },
{ REG_BADOPT,	"REG_BADOPT",	"invalid embedded option" },
{ REG_ETOOBIG,	"REG_ETOOBIG",	"nfa has too many states" },







>
13
14
15
16
17
18
19
20
{ REG_ESPACE,	"REG_ESPACE",	"out of memory" },
{ REG_BADRPT,	"REG_BADRPT",	"quantifier operand invalid" },
{ REG_ASSERT,	"REG_ASSERT",	"\"can't happen\" -- you found a bug" },
{ REG_INVARG,	"REG_INVARG",	"invalid argument to regex function" },
{ REG_MIXED,	"REG_MIXED",	"character widths of regex and string differ" },
{ REG_BADOPT,	"REG_BADOPT",	"invalid embedded option" },
{ REG_ETOOBIG,	"REG_ETOOBIG",	"nfa has too many states" },
{ REG_ECOLORS,	"REG_ECOLORS",	"too many colors" },

Changes to generic/regex.h.

289
290
291
292
293
294
295

296
297
298
299
300
301
302
#define	REG_ESPACE	12	/* out of memory */
#define	REG_BADRPT	13	/* quantifier operand invalid */
#define	REG_ASSERT	15	/* "can't happen" -- you found a bug */
#define	REG_INVARG	16	/* invalid argument to regex function */
#define	REG_MIXED	17	/* character widths of regex and string differ */
#define	REG_BADOPT	18	/* invalid embedded option */
#define	REG_ETOOBIG	19	/* nfa has too many states */

/* two specials for debugging and testing */
#define	REG_ATOI	101	/* convert error-code name to number */
#define	REG_ITOA	102	/* convert error-code number to name */



/*






>







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
#define	REG_ESPACE	12	/* out of memory */
#define	REG_BADRPT	13	/* quantifier operand invalid */
#define	REG_ASSERT	15	/* "can't happen" -- you found a bug */
#define	REG_INVARG	16	/* invalid argument to regex function */
#define	REG_MIXED	17	/* character widths of regex and string differ */
#define	REG_BADOPT	18	/* invalid embedded option */
#define	REG_ETOOBIG	19	/* nfa has too many states */
#define	REG_ECOLORS	20	/* too many colors */
/* two specials for debugging and testing */
#define	REG_ATOI	101	/* convert error-code name to number */
#define	REG_ITOA	102	/* convert error-code number to name */



/*

Changes to generic/regguts.h.

170
171
172
173
174
175
176

177
178
179
180
181
182
183
/*
 * As soon as possible, we map chrs into equivalence classes -- "colors" --
 * which are of much more manageable number.
 */
typedef short color;		/* colors of characters */
typedef int pcolor;		/* what color promotes to */

#define	COLORLESS	(-1)	/* impossible color */
#define	WHITE		0	/* default color, parent of all others */



/*
 * A colormap is a tree -- more precisely, a DAG -- indexed at each level






>







170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
/*
 * As soon as possible, we map chrs into equivalence classes -- "colors" --
 * which are of much more manageable number.
 */
typedef short color;		/* colors of characters */
typedef int pcolor;		/* what color promotes to */
#define MAX_COLOR	SHRT_MAX /* max color value */
#define	COLORLESS	(-1)	/* impossible color */
#define	WHITE		0	/* default color, parent of all others */



/*
 * A colormap is a tree -- more precisely, a DAG -- indexed at each level

Changes to generic/tclBasic.c.

4919
4920
4921
4922
4923
4924
4925

4926
4927
4928
4929
4930
4931
4932
4933

4934
4935
4936
4937
4938
4939
4940
 *
 * Side effects:
 *	See the functions they call.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_EvalObj(interp, objPtr)
    Tcl_Interp * interp;
    Tcl_Obj * objPtr;
{
    return Tcl_EvalObjEx(interp, objPtr, 0);
}


int
Tcl_GlobalEvalObj(interp, objPtr)
    Tcl_Interp * interp;
    Tcl_Obj * objPtr;
{
    return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}






>








>







4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
 *
 * Side effects:
 *	See the functions they call.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_EvalObj
int
Tcl_EvalObj(interp, objPtr)
    Tcl_Interp * interp;
    Tcl_Obj * objPtr;
{
    return Tcl_EvalObjEx(interp, objPtr, 0);
}

#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(interp, objPtr)
    Tcl_Interp * interp;
    Tcl_Obj * objPtr;
{
    return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}

Changes to generic/tclDecls.h.

4512
4513
4514
4515
4516
4517
4518










4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

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

#undef TclUnusedStubEntry











/*
 * Deprecated Tcl procedures:
 */
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
#   undef Tcl_EvalObj
#   define Tcl_EvalObj(interp,objPtr) \
	Tcl_EvalObjEx((interp),(objPtr),0)
#   undef Tcl_GlobalEvalObj
#   define Tcl_GlobalEvalObj(interp,objPtr) \
	Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif

#endif /* _TCLDECLS */







>
>
>
>
>
>
>
>
>
>



<
|
|
|
|
|
|
<



4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531

4532
4533
4534
4535
4536
4537

4538
4539
4540
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

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

#undef TclUnusedStubEntry

#undef Tcl_PkgPresent
#define Tcl_PkgPresent(interp, name, version, exact) \
	Tcl_PkgPresentEx(interp, name, version, exact, NULL)
#undef Tcl_PkgProvide
#define Tcl_PkgProvide(interp, name, version) \
	Tcl_PkgProvideEx(interp, name, version, NULL)
#undef Tcl_PkgRequire
#define Tcl_PkgRequire(interp, name, version, exact) \
	Tcl_PkgRequireEx(interp, name, version, exact, NULL)

/*
 * Deprecated Tcl procedures:
 */

#undef Tcl_EvalObj
#define Tcl_EvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),0)
#undef Tcl_GlobalEvalObj
#define Tcl_GlobalEvalObj(interp,objPtr) \
    Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)


#endif /* _TCLDECLS */

Changes to generic/tclPkg.c.

115
116
117
118
119
120
121

122
123
124
125
126
127
128
...
219
220
221
222
223
224
225

226
227
228
229
230
231
232
...
823
824
825
826
827
828
829

830
831
832
833
834
835
836
....
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
....
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
....
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
 *	The interpreter remembers that this package is available,
 *	so that no other version of the package may be provided for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */


int
Tcl_PkgProvide(interp, name, version)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of package. */
     CONST char *version;	/* Version string for package. */
{
................................................................................
     Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
     ClientData *clientDataPtr;
{
    return TCL_ERROR;
}
#endif


CONST char *
Tcl_PkgRequire(interp, name, version, exact)
    Tcl_Interp *interp;	        /* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version; NULL
				 * means use the latest version available. */
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */


CONST char *
Tcl_PkgPresent(interp, name, version, exact)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version;
				 * NULL means use the latest version
................................................................................
	    } 
	    if ((objc > 3) && (CheckVersionAndConvert(interp,
		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
		version = TclGetString(objv[3]);
	    }
	}
#endif
	Tcl_PkgPresent(interp, name, version, exact);
	return TCL_ERROR;
	break;
    }
    case PKG_PROVIDE: {
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;
................................................................................
#ifndef TCL_TIP268
	if (CheckVersion(interp, argv3) != TCL_OK) {
#else
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
#endif
	    return TCL_ERROR;
	}
	return Tcl_PkgProvide(interp, argv2, argv3);
    }
    case PKG_REQUIRE: {
    require:
	if (objc < 3) {
	requireSyntax:
#ifndef TCL_TIP268
	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
................................................................................
		return TCL_ERROR;
	    }
	} else if ((objc != 3) || exact) {
	    goto requireSyntax;
	}
	if (exact) {
	    argv3 =  Tcl_GetString(objv[3]);
	    version = Tcl_PkgRequire(interp, argv3, version, exact);
	} else {
	    version = Tcl_PkgRequire(interp, argv2, version, exact);
	}
	if (version == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
#else
	version = NULL;






>







 







>







 







>







 







|







 







|







 







|

|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
...
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
...
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
....
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
....
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
....
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
 *	The interpreter remembers that this package is available,
 *	so that no other version of the package may be provided for
 *	the interpreter.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgProvide
int
Tcl_PkgProvide(interp, name, version)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of package. */
     CONST char *version;	/* Version string for package. */
{
................................................................................
     Tcl_Obj *CONST reqv[];     /* 0 means to use the latest version available. */
     ClientData *clientDataPtr;
{
    return TCL_ERROR;
}
#endif

#undef Tcl_PkgRequire
CONST char *
Tcl_PkgRequire(interp, name, version, exact)
    Tcl_Interp *interp;	        /* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version; NULL
				 * means use the latest version available. */
................................................................................
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_PkgPresent
CONST char *
Tcl_PkgPresent(interp, name, version, exact)
     Tcl_Interp *interp;	/* Interpreter in which package is now
				 * available. */
     CONST char *name;		/* Name of desired package. */
     CONST char *version;	/* Version string for desired version;
				 * NULL means use the latest version
................................................................................
	    } 
	    if ((objc > 3) && (CheckVersionAndConvert(interp,
		    TclGetString(objv[3]), NULL, NULL) == TCL_OK)) {
		version = TclGetString(objv[3]);
	    }
	}
#endif
	Tcl_PkgPresentEx(interp, name, version, exact, NULL);
	return TCL_ERROR;
	break;
    }
    case PKG_PROVIDE: {
	if ((objc != 3) && (objc != 4)) {
	    Tcl_WrongNumArgs(interp, 2, objv, "package ?version?");
	    return TCL_ERROR;
................................................................................
#ifndef TCL_TIP268
	if (CheckVersion(interp, argv3) != TCL_OK) {
#else
	if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
#endif
	    return TCL_ERROR;
	}
	return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
    }
    case PKG_REQUIRE: {
    require:
	if (objc < 3) {
	requireSyntax:
#ifndef TCL_TIP268
	    Tcl_WrongNumArgs(interp, 2, objv, "?-exact? package ?version?");
................................................................................
		return TCL_ERROR;
	    }
	} else if ((objc != 3) || exact) {
	    goto requireSyntax;
	}
	if (exact) {
	    argv3 =  Tcl_GetString(objv[3]);
	    version = Tcl_PkgRequireEx(interp, argv3, version, exact, NULL);
	} else {
	    version = Tcl_PkgRequireEx(interp, argv2, version, exact, NULL);
	}
	if (version == NULL) {
	    return TCL_ERROR;
	}
	Tcl_SetObjResult( interp, Tcl_NewStringObj( version, -1 ) );
#else
	version = NULL;

Changes to library/http/http.tcl.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
...
385
386
387
388
389
390
391






392
393
394
395
396
397
398
#	favor of raising an error
# 2.4	Added -binary option to http::geturl and charset element to the state
#	array.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories
# in Makefiles
package provide http 2.5.7

namespace eval http {
    variable http
    array set http {
	-accept */*
	-proxyhost {}
	-proxyport {}
................................................................................
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    ( [^/:\#?]+ )		# <host part of authority>
	    (?: : (\d+) )?		# <port part of authority>
	)?
	( / [^\#?]* (?: \? [^\#?]* )?)?	# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
................................................................................
		return -code error \
			"Illegal encoding character usage \"$bad\" in URL user"
	    }
	    return -code error "Illegal characters in URL user"
	}
    }
    if {$srvurl ne ""} {






	# Check for validity according to RFC 3986, Appendix A
	set validityRE {(?xi)
	    ^
	    # Path part (already must start with / character)
	    (?:	      [-\w.~!$&'()*+,;=:@/]  | %[0-9a-f][0-9a-f] )*
	    # Query part (optional, permits ? characters)
	    (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?






|







 







|







 







>
>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
...
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
#	favor of raising an error
# 2.4	Added -binary option to http::geturl and charset element to the state
#	array.

package require Tcl 8.4
# Keep this in sync with pkgIndex.tcl and with the install directories
# in Makefiles
package provide http 2.5.8

namespace eval http {
    variable http
    array set http {
	-accept */*
	-proxyhost {}
	-proxyport {}
................................................................................
		(
		    [^@/\#?]+		# <userinfo part of authority>
		) @
	    )?
	    ( [^/:\#?]+ )		# <host part of authority>
	    (?: : (\d+) )?		# <port part of authority>
	)?
	( [/\?] [^\#]*)?		# <path> (including query)
	(?: \# (.*) )?			# <fragment>
	$
    }

    # Phase one: parse
    if {![regexp -- $URLmatcher $url -> proto user host port srvurl]} {
	unset $token
................................................................................
		return -code error \
			"Illegal encoding character usage \"$bad\" in URL user"
	    }
	    return -code error "Illegal characters in URL user"
	}
    }
    if {$srvurl ne ""} {
	# RFC 3986 allows empty paths (not even a /), but servers
	# return 400 if the path in the HTTP request doesn't start
	# with / , so add it here if needed.
	if {[string index $srvurl 0] ne "/"} {
	    set srvurl /$srvurl
	}
	# Check for validity according to RFC 3986, Appendix A
	set validityRE {(?xi)
	    ^
	    # Path part (already must start with / character)
	    (?:	      [-\w.~!$&'()*+,;=:@/]  | %[0-9a-f][0-9a-f] )*
	    # Query part (optional, permits ? characters)
	    (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?

Changes to library/http/pkgIndex.tcl.

5
6
7
8
9
10
11
12
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.5.7 [list tclPkgSetup $dir http 2.5.7 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]






|
5
6
7
8
9
10
11
12
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded http 2.5.8 [list tclPkgSetup $dir http 2.5.8 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

Changes to tests/http.test.

131
132
133
134
135
136
137

138
139
140
141
142
143
144
...
336
337
338
339
340
341
342













343
344
345
346
347
348
349
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:[email protected][info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set badcharurl //%[email protected][info hostname]:$port/a/^b/c


test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
................................................................................
    http::geturl http://somewhere/path?%query
} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
test http-3.25 {http::geturl parse failures} -body {
    set ::http::strict 0
    set token [http::geturl $badcharurl]
    http::cleanup $token
} -returnCodes ok -result {}














test http-4.1 {http::Event} {
    set token [http::geturl $url]
    upvar #0 $token data
    array set meta $data(meta)
    expr ($data(totalsize) == $meta(Content-Length))
} 1






>







 







>
>
>
>
>
>
>
>
>
>
>
>
>







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
...
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
set tail /a/b/c
set url //[info hostname]:$port/a/b/c
set fullurl http://user:[email protected][info hostname]:$port/a/b/c
set binurl //[info hostname]:$port/binary
set posturl //[info hostname]:$port/post
set badposturl //[info hostname]:$port/droppost
set badcharurl //%[email protected][info hostname]:$port/a/^b/c
set authorityurl //[info hostname]:$port

test http-3.4 {http::geturl} {
    set token [http::geturl $url]
    http::data $token
} "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET $tail</h2>
................................................................................
    http::geturl http://somewhere/path?%query
} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
test http-3.25 {http::geturl parse failures} -body {
    set ::http::strict 0
    set token [http::geturl $badcharurl]
    http::cleanup $token
} -returnCodes ok -result {}
test http-3.30 {http::geturl query without path} -body {
    set token [http::geturl $authorityurl?var=val]
    http::ncode $token
} -cleanup {
    catch { http::cleanup $token }
} -result 200
test http-3.31 {http::geturl fragment without path} -body {
    set token [http::geturl "$authorityurl#fragment42"]
    http::ncode $token
} -cleanup {
    catch { http::cleanup $token }
} -result 200


test http-4.1 {http::Event} {
    set token [http::geturl $url]
    upvar #0 $token data
    array set meta $data(meta)
    expr ($data(totalsize) == $meta(Content-Length))
} 1

Changes to tests/regexp.test.

675
676
677
678
679
680
681











682
683
684
685
	[a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \
	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a
} -cleanup {
    rename a {}
} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states}












# cleanup
::tcltest::cleanupTests
return






>
>
>
>
>
>
>
>
>
>
>




675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
	[a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
	[a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \
	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a
} -cleanup {
    rename a {}
} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states}
test regexp-22.5 {Bug 3610026} -setup {
    set e {}
    set cp 99
    while {$cp < 32864} {
	append e [format %c [incr cp]]
    }
} -body {
    regexp -about $e
} -cleanup {
    unset -nocomplain e cp
} -returnCodes error  -match glob -result {*too many colors*}

# cleanup
::tcltest::cleanupTests
return

Changes to unix/dltest/pkgb.c.

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
................................................................................

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}






|







 







|







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
................................................................................

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}