Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | [39fed4dae5] Proposed test |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | pkg-return-check |
| Files: | files | file ages | folders |
| SHA3-256: |
e130dc3db2500718d5cd780e4dfcf45e |
| User & Date: | dgp 2019-03-07 20:02:09 |
Context
|
2019-03-07
| ||
| 20:05 | Merge forward to demonstrate the test fails after the bug arrived. Closed-Leaf check-in: 89f964c345 user: dgp tags: pkg-return-check | |
| 20:02 | [39fed4dae5] Proposed test check-in: e130dc3db2 user: dgp tags: pkg-return-check | |
|
2017-12-23
| ||
| 18:33 | merge release check-in: 357365b905 user: jan.nijtmans tags: core-8-6-branch | |
Changes
Changes to generic/tclTestProcBodyObj.c.
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 .. 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 ... 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 |
#include "tclInt.h" /* * name and version of this package */ static const char packageName[] = "procbodytest"; static const char packageVersion[] = "1.0"; /* * Name of the commands exported by this package */ static const char procCommand[] = "proc"; /* * this struct describes an entry in the table of command names and command * procs */ typedef struct CmdTable { ................................................................................ } CmdTable; /* * Declarations for functions defined in this file. */ static int ProcBodyTestProcObjCmd(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 }, { 0, 0, 0 } }; static const CmdTable safeCommands[] = { { procCommand, ProcBodyTestProcObjCmd, 1 }, { 0, 0, 0 } }; /* *---------------------------------------------------------------------- * * Procbodytest_Init -- ................................................................................ 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: */ |
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 .. 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 ... 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 |
#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 { ................................................................................ } 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 -- ................................................................................ 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); 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.
309 310 311 312 313 314 315 316 317 318 319 320 321 322 |
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
|
> > > |
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 |
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
|