Tcl Source Code

Check-in [0a4f70654f]
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:Better fix, not hackish any-more, but retaining the original idea
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | jn-bug-39fed4dae5
Files: files | file ages | folders
SHA3-256: 0a4f70654fade849377b9ccade0ef7827557bae0ca9bb0f50111ae50eccfa732
User & Date: jan.nijtmans 2019-03-07 09:43:01
Context
2019-03-07
09:45
but ... don't call Tcl_GetObjResult() twice Closed-Leaf check-in: 5011be2338 user: jan.nijtmans tags: jn-bug-39fed4dae5
09:43
Better fix, not hackish any-more, but retaining the original idea check-in: 0a4f70654f user: jan.nijtmans tags: jn-bug-39fed4dae5
2019-03-06
15:36
Fix for [39fed4dae5]. Closed-Leaf check-in: 87689a5b66 user: pooryorick tags: pyk-bug-39fed4dae5
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclPkg.c.

202
203
204
205
206
207
208





















209
210
211
212
213
214
215
...
314
315
316
317
318
319
320


321

322
323
324
325
326
327
328
329
330
331
332
333
334


335

336
337
338
339
340
341
342
...
493
494
495
496
497
498
499
500


501
502
503
504
505
506
507
...
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
 *
 * Side effects:
 *	The script from some previous "package ifneeded" command may be
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */






















#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
................................................................................

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {


	    result = Tcl_GetObjResult(interp)->internalRep.twoPtrValue.ptr1;

	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {


	    result = Tcl_GetObjResult(interp)->internalRep.twoPtrValue.ptr1;

	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

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

    if (clientDataPtr) {
	const void **ptr = (const void **) clientDataPtr;

	*ptr = reqPtr->pkgPtr->clientData;
    }

    res = Tcl_NewStringObj(reqPtr->pkgPtr->version ,-1);


    res->internalRep.twoPtrValue.ptr1 = reqPtr->pkgPtr->version;
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
................................................................................

 
static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies; 
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;







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







 







>
>
|
>













>
>
|
>







 







|
>
>







 







|







202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
...
335
336
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
364
365
366
367
368
369
...
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
...
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
 *
 * Side effects:
 *	The script from some previous "package ifneeded" command may be
 *	invoked to provide the package.
 *
 *----------------------------------------------------------------------
 */

static void
UpdateStringOfPkgVersion(
    register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
{
    const char *pkgVersion = objPtr->internalRep.twoPtrValue.ptr1;
    size_t len = strlen(pkgVersion);

    objPtr->bytes = ckalloc(len + 1);
    memcpy(objPtr->bytes, pkgVersion, len + 1);
    objPtr->length = len;
}

const Tcl_ObjType tclPkgVersionType = {
    "pkgVersion",			/* name */
    NULL,			/* freeIntRepProc */
    NULL,			/* dupIntRepProc */
    UpdateStringOfPkgVersion,	/* updateStringProc */
	NULL		/* setFromAnyProc */
};


#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
    Tcl_Interp *interp,		/* Interpreter in which package is now
				 * available. */
    const char *name,		/* Name of desired package. */
................................................................................

    /*
     * Translate between old and new API, and defer to the new function.
     */

    if (version == NULL) {
	if (Tcl_PkgRequireProc(interp, name, 0, NULL, clientDataPtr) == TCL_OK) {
		Tcl_Obj *obj = Tcl_GetObjResult(interp);
		if (obj->typePtr == &tclPkgVersionType) {
		    result = Tcl_GetObjResult(interp)->internalRep.twoPtrValue.ptr1;
		}
	    Tcl_ResetResult(interp);
	}
    } else {
	if (exact && TCL_OK
		!= CheckVersionAndConvert(interp, version, NULL, NULL)) {
	    return NULL;
	}
	ov = Tcl_NewStringObj(version, -1);
	if (exact) {
	    Tcl_AppendStringsToObj(ov, "-", version, NULL);
	}
	Tcl_IncrRefCount(ov);
	if (Tcl_PkgRequireProc(interp, name, 1, &ov, clientDataPtr) == TCL_OK) {
		Tcl_Obj *obj = Tcl_GetObjResult(interp);
		if (obj->typePtr == &tclPkgVersionType) {
		    result = Tcl_GetObjResult(interp)->internalRep.twoPtrValue.ptr1;
		}
	    Tcl_ResetResult(interp);
	}
	TclDecrRefCount(ov);
    }
    return result;
}

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

    if (clientDataPtr) {
	const void **ptr = (const void **) clientDataPtr;

	*ptr = reqPtr->pkgPtr->clientData;
    }

    TclNewObj(res);
    res->bytes = NULL;
    res->typePtr = &tclPkgVersionType;
    res->internalRep.twoPtrValue.ptr1 = reqPtr->pkgPtr->version;
    Tcl_SetObjResult(interp, res);
    return TCL_OK;
}

static int
PkgRequireCoreCleanup(ClientData data[], Tcl_Interp *interp, int result) {
................................................................................

 
static int
SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
    PkgAvail *availPtr, *bestPtr, *bestStablePtr;
    char *availVersion, *bestVersion, *bestStableVersion;
				/* Internal rep. of versions */
    int availStable, satisfies;
    Require *reqPtr = data[0];
    int reqc = PTR2INT(data[1]);
    Tcl_Obj **const reqv = data[2];
    const char *name = reqPtr->name;
    Package *pkgPtr = reqPtr->pkgPtr;
    Interp *iPtr = (Interp *) interp;