Tcl Source Code

Check-in [a2fcb8020d]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:More generation of errorCode information (default [bgerror] and [glob]).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a2fcb8020de3acfa3ffabd4a342af8b6f0e12935
User & Date: dkf 2011-04-02 12:17:32
Context
2011-04-02
17:22
More generation of errorCodes ([interp], [lset], [load], [unload]). check-in: d109deac44 user: dkf tags: trunk
12:17
More generation of errorCode information (default [bgerror] and [glob]). check-in: a2fcb8020d user: dkf tags: trunk
2011-04-01
10:48
mathematical version of TIP#131 check-in: c5a8b77ec4 user: max tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 






1
2
3
4
5
6
7






2011-04-01  Reinhard Max  <[email protected]>

	* library/init.tcl: TIP#131 implementation.

2011-03-31  Donal K. Fellows  <[email protected]>

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):

>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12

2011-04-02  Donal K. Fellows  <[email protected]>

	* generic/tclEvent.c, generic/tclFileName.c: More generation of
	errorCode information (default [bgerror] and [glob]).

2011-04-01  Reinhard Max  <[email protected]>

	* library/init.tcl: TIP#131 implementation.

2011-03-31  Donal K. Fellows  <[email protected]>

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
︙︙

Changes to generic/tclEvent.c.

︙︙
329
330
331
332
333
334
335

336
337
338
339
340
341
342
343
344
345
346
347

348
349
350
351
352
353
354

    TclNewLiteralStringObj(keyPtr, "-level");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-level\"", -1));

	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
	return TCL_ERROR;
    }
    TclNewLiteralStringObj(keyPtr, "-code");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-code\"", -1));

	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (level != 0) {








>












>








329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356

    TclNewLiteralStringObj(keyPtr, "-level");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-level\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &level) == TCL_ERROR) {
	return TCL_ERROR;
    }
    TclNewLiteralStringObj(keyPtr, "-code");
    Tcl_IncrRefCount(keyPtr);
    Tcl_DictObjGet(NULL, objv[2], keyPtr, &valuePtr);
    Tcl_DecrRefCount(keyPtr);
    if (valuePtr == NULL) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"missing return option \"-code\"", -1));
	Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, valuePtr, &code) == TCL_ERROR) {
	return TCL_ERROR;
    }

    if (level != 0) {
︙︙

Changes to generic/tclFileName.c.

︙︙
1254
1255
1256
1257
1258
1259
1260

1261
1262
1263
1264
1265


1266
1267
1268
1269
1270
1271
1272
1273
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

	case GLOB_NOCOMPLAIN:			/* -nocomplain */
	    globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
	    break;
	case GLOB_DIR:				/* -dir */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-directory\"", -1));

		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-directory\" cannot be used with \"-path\"", -1));


		return TCL_ERROR;
	    }
	    dir = PATH_DIR;
	    globFlags |= TCL_GLOBMODE_DIR;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_JOIN:				/* -join */
	    join = 1;
	    break;
	case GLOB_TAILS:				/* -tails */
	    globFlags |= TCL_GLOBMODE_TAILS;
	    break;
	case GLOB_PATH:				/* -path */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-path\"", -1));

		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-path\" cannot be used with \"-directory\"", -1));


		return TCL_ERROR;
	    }
	    dir = PATH_GENERAL;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_TYPE:				/* -types */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-types\"", -1));

		return TCL_ERROR;
	    }
	    typePtr = objv[i+1];
	    if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    i++;
	    break;
	case GLOB_LAST:				/* -- */
	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_AppendResult(interp,
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", NULL);


	return TCL_ERROR;
    }

    separators = NULL;		/* lint. */
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	separators = "/";








>





>
>

















>





>
>










>



















>
>








1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
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

	case GLOB_NOCOMPLAIN:			/* -nocomplain */
	    globFlags |= TCL_GLOBMODE_NO_COMPLAIN;
	    break;
	case GLOB_DIR:				/* -dir */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-directory\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-directory\" cannot be used with \"-path\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_DIR;
	    globFlags |= TCL_GLOBMODE_DIR;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_JOIN:				/* -join */
	    join = 1;
	    break;
	case GLOB_TAILS:				/* -tails */
	    globFlags |= TCL_GLOBMODE_TAILS;
	    break;
	case GLOB_PATH:				/* -path */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-path\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    if (dir != PATH_NONE) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"\"-path\" cannot be used with \"-directory\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
			"BADOPTIONCOMBINATION", NULL);
		return TCL_ERROR;
	    }
	    dir = PATH_GENERAL;
	    pathOrDir = objv[i+1];
	    i++;
	    break;
	case GLOB_TYPE:				/* -types */
	    if (i == (objc-1)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"missing argument to \"-types\"", -1));
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
		return TCL_ERROR;
	    }
	    typePtr = objv[i+1];
	    if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) {
		return TCL_ERROR;
	    }
	    i++;
	    break;
	case GLOB_LAST:				/* -- */
	    i++;
	    goto endOfForLoop;
	}
    }

  endOfForLoop:
    if ((globFlags & TCL_GLOBMODE_TAILS) && (pathOrDir == NULL)) {
	Tcl_AppendResult(interp,
		"\"-tails\" must be used with either "
		"\"-directory\" or \"-path\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB",
		"BADOPTIONCOMBINATION", NULL);
	return TCL_ERROR;
    }

    separators = NULL;		/* lint. */
    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	separators = "/";
︙︙
1519
1520
1521
1522
1523
1524
1525

1526
1527
1528
1529
1530
1531
1532
1533
1534

1535
1536
1537
1538
1539
1540
1541

		 */

	    badTypesArg:
		TclNewObj(resultPtr);
		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
		Tcl_AppendObjToObj(resultPtr, look);
		Tcl_SetObjResult(interp, resultPtr);

		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"only one MacOS type or creator argument"
			" to \"-types\" allowed", -1));
		result = TCL_ERROR;

		join = 0;
		goto endOfGlob;
	    }
	}
    }

  skipTypes:








>









>








1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552

		 */

	    badTypesArg:
		TclNewObj(resultPtr);
		Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
		Tcl_AppendObjToObj(resultPtr, look);
		Tcl_SetObjResult(interp, resultPtr);
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		result = TCL_ERROR;
		join = 0;
		goto endOfGlob;

	    badMacTypesArg:
		Tcl_SetObjResult(interp, Tcl_NewStringObj(
			"only one MacOS type or creator argument"
			" to \"-types\" allowed", -1));
		result = TCL_ERROR;
		Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
		join = 0;
		goto endOfGlob;
	    }
	}
    }

  skipTypes:
︙︙
1616
1617
1618
1619
1620
1621
1622


1623
1624
1625
1626
1627
1628
1629

		for (i = 0; i < objc; i++) {
		    string = Tcl_GetString(objv[i]);
		    Tcl_AppendResult(interp, sep, string, NULL);
		    sep = " ";
		}
	    }
	    Tcl_AppendResult(interp, "\"", NULL);


	    result = TCL_ERROR;
	}
    }

  endOfGlob:
    if (join || (dir == PATH_GENERAL)) {
	Tcl_DStringFree(&prefix);








>
>








1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642

		for (i = 0; i < objc; i++) {
		    string = Tcl_GetString(objv[i]);
		    Tcl_AppendResult(interp, sep, string, NULL);
		    sep = " ";
		}
	    }
	    Tcl_AppendResult(interp, "\"", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "NOMATCH",
		    NULL);
	    result = TCL_ERROR;
	}
    }

  endOfGlob:
    if (join || (dir == PATH_GENERAL)) {
	Tcl_DStringFree(&prefix);
︙︙
2246
2247
2248
2249
2250
2251
2252


2253
2254
2255
2256
2257


2258
2259
2260
2261
2262
2263
2264

		 */

		closeBrace = p;
		break;
	    }
	    Tcl_SetResult(interp, "unmatched open-brace in file name",
		    TCL_STATIC);


	    return TCL_ERROR;

	} else if (*p == '}') {
	    Tcl_SetResult(interp, "unmatched close-brace in file name",
		    TCL_STATIC);


	    return TCL_ERROR;
	}
    }

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */








>
>





>
>








2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281

		 */

		closeBrace = p;
		break;
	    }
	    Tcl_SetResult(interp, "unmatched open-brace in file name",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;

	} else if (*p == '}') {
	    Tcl_SetResult(interp, "unmatched close-brace in file name",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "GLOB", "BALANCE",
		    NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */
︙︙

This page was generated in about 0.057s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19