Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Integrate the test, which seems to indicate the bug fix doesn't work. More to come.... |
|---|---|
| Downloads: | Tarball | ZIP archive |
| Timelines: | family | ancestors | descendants | both | bug-39fed4dae5 |
| Files: | files | file ages | folders |
| SHA3-256: |
e3fa2e57a831baea6bd47d128522cbac |
| User & Date: | dgp 2019-03-07 20:24:53.178 |
Context
|
2019-03-07
| ||
| 22:13 | In the 8.6.* releases, Tcl_GetStringResult() still passes through interp->result. Have to ask specif... Closed-Leaf check-in: e6479634cb user: dgp tags: bug-39fed4dae5 | |
| 20:24 | Integrate the test, which seems to indicate the bug fix doesn't work. More to come.... check-in: e3fa2e57a8 user: dgp tags: bug-39fed4dae5 | |
| 20:05 | Merge forward to demonstrate the test fails after the bug arrived. Closed-Leaf check-in: 89f964c345 user: dgp tags: pkg-return-check | |
|
2019-03-06
| ||
| 01:42 |
[39fed4dae5] Minimal fix for volatile lifetime of string returned by
Tcl_PkgRequire().
We need a te... check-in: bec67444fa user: dgp tags: bug-39fed4dae5 | |
Changes
Changes to generic/tclTestProcBodyObj.c.
| ︙ | ︙ | |||
17 18 19 20 21 22 23 | #include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "procbodytest"; | | > > > > > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
#include "tclInt.h"
/*
* name and version of this package
*/
static const char packageName[] = "procbodytest";
static const char packageVersion[] = "1.1";
/*
* Name of the commands exported by this package
*/
static const char procCommand[] = "proc";
static const char checkCommand[] = "check";
/*
* this struct describes an entry in the table of command names and command
* procs
*/
typedef struct CmdTable {
const char *cmdName; /* command name */
Tcl_ObjCmdProc *proc; /* command proc */
int exportIt; /* if 1, export the command */
} CmdTable;
/*
* Declarations for functions defined in this file.
*/
static int ProcBodyTestProcObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int ProcBodyTestCheckObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int ProcBodyTestInitInternal(Tcl_Interp *interp, int isSafe);
static int RegisterCommand(Tcl_Interp* interp,
const char *namespace, const CmdTable *cmdTablePtr);
/*
* List of commands to create when the package is loaded; must go after the
* declarations of the enable command procedure.
*/
static const CmdTable commands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
{ 0, 0, 0 }
};
static const CmdTable safeCommands[] = {
{ procCommand, ProcBodyTestProcObjCmd, 1 },
{ checkCommand, ProcBodyTestCheckObjCmd, 1 },
{ 0, 0, 0 }
};
/*
*----------------------------------------------------------------------
*
* Procbodytest_Init --
|
| ︙ | ︙ | |||
295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 |
myobjv[4] = NULL;
result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
Tcl_DecrRefCount(bodyObjPtr);
return result;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 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 343 344 345 346 347 348 349 350 351 352 353 354 355 356 |
myobjv[4] = NULL;
result = Tcl_ProcObjCmd(NULL, interp, objc, myobjv);
Tcl_DecrRefCount(bodyObjPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestCheckObjCmd --
*
* Implements the "procbodytest::check" command. Here is the command
* description:
* procbodytest::check
*
* Performs an internal check that the Tcl_PkgPresent() command returns
* the same version number as was registered when the procbodytest package
* was provided. Places a boolean in the interp result indicating the
* test outcome.
*
* Results:
* Returns a standard Tcl code.
*
*----------------------------------------------------------------------
*/
static int
ProcBodyTestCheckObjCmd(
ClientData dummy, /* context; not used */
Tcl_Interp *interp, /* the current interpreter */
int objc, /* argument count */
Tcl_Obj *const objv[]) /* arguments */
{
const char *version;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
version = Tcl_PkgPresent(interp, packageName, packageVersion, 1);
fprintf(stdout, "CHECK %p '%s' %p '%s'\n", version, version,
packageVersion, packageVersion); fflush(stdout);
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
strcmp(version, packageVersion) == 0));
return TCL_OK;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to tests/proc.test.
| ︙ | ︙ | |||
317 318 319 320 321 322 323 324 325 326 327 328 329 330 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
| > > > | 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 |
set end [getbytes]
}
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
rename getbytes {}
unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest {
procbodytest::check
} 1
test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
proc p args {} ; # this will be bytecompiled into t
proc t {} {
set res {}
set a 0
set b 0
|
| ︙ | ︙ |