Tcl Source Code

Check-in [6f9b318d26]
Login
EuroTcl/OpenACS 11 - 12 JULY 2024, VIENNA

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

Overview
Comment:merge 8.6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: 6f9b318d267e1f43173c3ae706b82765553accbf3b5ae06928045b3485fd8c6a
User & Date: sebres 2024-07-02 14:38:06
Context
2024-07-03
13:09
Merge 8.6 Leaf check-in: e715cf23da user: jan.nijtmans tags: core-8-branch
2024-07-02
14:39
merge 8.7 check-in: 8a4c0f4a93 user: sebres tags: trunk, main
14:38
merge 8.6 check-in: 6f9b318d26 user: sebres tags: core-8-branch
14:36
info frame: restored return {type precompiled} in case of no frame information; see [0de6c1d79cfba2e... check-in: 8c2c0a6d7d user: sebres tags: core-8-6-branch
12:38
merge 8.6 check-in: c0b9e076c4 user: sebres tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclCmdIL.c.

1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
     */

    if (level > 0) {
	level -= topLevel;
    }

    framePtr = iPtr->cmdFramePtr;
    if (!framePtr) {
	goto levelError;
    }
    while (++level <= 0) {
	framePtr = framePtr->nextPtr;
	if (!framePtr) {
	    goto levelError;
	}
    }








<
<
<







1194
1195
1196
1197
1198
1199
1200



1201
1202
1203
1204
1205
1206
1207
     */

    if (level > 0) {
	level -= topLevel;
    }

    framePtr = iPtr->cmdFramePtr;



    while (++level <= 0) {
	framePtr = framePtr->nextPtr;
	if (!framePtr) {
	    goto levelError;
	}
    }

1265
1266
1267
1268
1269
1270
1271
1272
1273
1274





1275
1276
1277
1278
1279
1280
1281
    /*
     * This array is indexed by the TCL_LOCATION_... values, except
     * for _LAST.
     */
    static const char *const typeString[TCL_LOCATION_LAST] = {
	"eval", "eval", "eval", "precompiled", "source", "proc"
    };
    Proc *procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;
    int needsFree = -1;






    /*
     * Pull the information and construct the dictionary to return, as list.
     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
     */

#define ADD_PAIR(name, value) \
	TclNewLiteralStringObj(tmpObj, name); \







|


>
>
>
>
>







1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
    /*
     * This array is indexed by the TCL_LOCATION_... values, except
     * for _LAST.
     */
    static const char *const typeString[TCL_LOCATION_LAST] = {
	"eval", "eval", "eval", "precompiled", "source", "proc"
    };
    Proc *procPtr = NULL;
    int needsFree = -1;

    if (!framePtr) {
	goto precompiled;
    }
    procPtr = framePtr->framePtr ? framePtr->framePtr->procPtr : NULL;

    /*
     * Pull the information and construct the dictionary to return, as list.
     * Regarding use of the CmdFrame fields see tclInt.h, and its definition.
     */

#define ADD_PAIR(name, value) \
	TclNewLiteralStringObj(tmpObj, name); \
1295
1296
1297
1298
1299
1300
1301

1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
	} else {
	    ADD_PAIR("line", Tcl_NewWideIntObj(1));
	}
	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
	break;

    case TCL_LOCATION_PREBC:

	/*
	 * Precompiled. Result contains the type as signal, nothing else.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */








>



<
|







1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307

1308
1309
1310
1311
1312
1313
1314
1315
	} else {
	    ADD_PAIR("line", Tcl_NewWideIntObj(1));
	}
	ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
	break;

    case TCL_LOCATION_PREBC:
      precompiled:
	/*
	 * Precompiled. Result contains the type as signal, nothing else.
	 */

	ADD_PAIR("type", Tcl_NewStringObj(typeString[TCL_LOCATION_PREBC], -1));
	break;

    case TCL_LOCATION_BC: {
	/*
	 * Execution of bytecode. Talk to the BC engine to fill out the frame.
	 */

1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
    }

    /*
     * 'level'. Common to all frame types. Conditional on having an associated
     * _visible_ CallFrame.
     */

    if ((framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
	CallFrame *current = framePtr->framePtr;
	CallFrame *top = iPtr->varFramePtr;
	CallFrame *idx;

	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
	    if (idx == current) {
		int c = framePtr->framePtr->level;







|







1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
    }

    /*
     * 'level'. Common to all frame types. Conditional on having an associated
     * _visible_ CallFrame.
     */

    if (framePtr && (framePtr->framePtr != NULL) && (iPtr->varFramePtr != NULL)) {
	CallFrame *current = framePtr->framePtr;
	CallFrame *top = iPtr->varFramePtr;
	CallFrame *idx;

	for (idx=top ; idx!=NULL ; idx=idx->callerVarPtr) {
	    if (idx == current) {
		int c = framePtr->framePtr->level;

Changes to tests/info.test.

2584
2585
2586
2587
2588
2589
2590


2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
} -result 3

test info-40.0 {Bug 0de6c1d79c crash} -setup {
    interp create child
    child hide info
} -body {
    list [child invokehidden info frame] \


	[catch {child invokehidden info frame 0} msg] $msg \
	[catch {child invokehidden info frame 1} msg] $msg
} -cleanup {
    interp delete child
    unset -nocomplain msg
} -result {1 1 {bad level "0"} 1 {bad level "1"}}

# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return







>
>
|
|



|





2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
} -result 3

test info-40.0 {Bug 0de6c1d79c crash} -setup {
    interp create child
    child hide info
} -body {
    list [child invokehidden info frame] \
	[child invokehidden info frame 0] \
	[child invokehidden info frame 1] \
	[catch {child invokehidden info frame -1} msg] $msg \
	[catch {child invokehidden info frame 2} msg] $msg
} -cleanup {
    interp delete child
    unset -nocomplain msg
} -result {1 {type precompiled} {type precompiled} 1 {bad level "-1"} 1 {bad level "2"}}

# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return