Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Code cleanup: Remove unneeded #undef's, and unneeded inclused. No change in functionality. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
b2f37675d3b8f6ead6a8924639e0427b |
| User & Date: | jan.nijtmans 2019-03-24 18:14:04 |
Context
|
2019-03-24
| ||
| 22:39 | Remove one more comment, which is no longer valid (as "exception" is now removed) check-in: 87009ec717 user: jan.nijtmans tags: trunk | |
| 18:14 | Code cleanup: Remove unneeded #undef's, and unneeded inclused. No change in functionality. check-in: b2f37675d3 user: jan.nijtmans tags: trunk | |
| 18:12 | Remove hacked exception for bug [a16752c252]. Should be fixed by then in "tclcompiler". Taken over f... check-in: 4a8c5ad29a user: jan.nijtmans tags: trunk | |
Changes
Changes to generic/tclPkg.c.
2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 |
const char *
Tcl_PkgInitStubsCheck(
Tcl_Interp *interp,
const char * version,
int exact)
{
const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
if ((exact&1) && actualVersion) {
const char *p = version;
int count = 0;
while (*p) {
count += !isdigit(UCHAR(*p++));
}
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
Tcl_PkgPresent(interp, "Tcl", version, 1);
return NULL;
}
} else {
return Tcl_PkgPresent(interp, "Tcl", version, 1);
}
}
return actualVersion;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
| | | |
2163 2164 2165 2166 2167 2168 2169 2170 2171 2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183 2184 2185 2186 2187 2188 2189 2190 2191 2192 2193 2194 2195 2196 2197 |
const char *
Tcl_PkgInitStubsCheck(
Tcl_Interp *interp,
const char * version,
int exact)
{
const char *actualVersion = Tcl_PkgPresentEx(interp, "Tcl", version, 0, NULL);
if ((exact&1) && actualVersion) {
const char *p = version;
int count = 0;
while (*p) {
count += !isdigit(UCHAR(*p++));
}
if (count == 1) {
if (0 != strncmp(version, actualVersion, strlen(version))) {
/* Construct error message */
Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
return NULL;
}
} else {
return Tcl_PkgPresentEx(interp, "Tcl", version, 1, NULL);
}
}
return actualVersion;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
Changes to generic/tclResult.c.
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
...
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
|
* Tcl_GetErrorLine -- * * Returns the line number associated with the current error. * *---------------------------------------------------------------------- */ #undef Tcl_GetErrorLine int Tcl_GetErrorLine( Tcl_Interp *interp) { return ((Interp *) interp)->errorLine; } ................................................................................ * Tcl_SetErrorLine -- * * Sets the line number associated with the current error. * *---------------------------------------------------------------------- */ #undef Tcl_SetErrorLine void Tcl_SetErrorLine( Tcl_Interp *interp, int value) { ((Interp *) interp)->errorLine = value; } |
<
<
|
611
612
613
614
615
616
617
618
619
620
621
622
623
624
...
628
629
630
631
632
633
634
635
636
637
638
639
640
641
|
* Tcl_GetErrorLine --
*
* Returns the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
int
Tcl_GetErrorLine(
Tcl_Interp *interp)
{
return ((Interp *) interp)->errorLine;
}
................................................................................
* Tcl_SetErrorLine --
*
* Sets the line number associated with the current error.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetErrorLine(
Tcl_Interp *interp,
int value)
{
((Interp *) interp)->errorLine = value;
}
|
Changes to generic/tclStubInit.c.
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 |
/* * Remove macros that will interfere with the definitions below. */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc #undef Tcl_NewBooleanObj #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj #undef Tcl_NewIntObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_FindHashEntry #undef Tcl_CreateHashEntry #undef Tcl_Panic #undef Tcl_FindExecutable #undef Tcl_SetExitProc #undef Tcl_SetPanicProc #undef TclpGetPid #undef TclSockMinimumBuffers #undef Tcl_SetIntObj #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #ifdef TCL_MEM_DEBUG # define Tcl_Alloc TclpAlloc # define Tcl_Free TclpFree |
< < < < < < < < |
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 |
/* * Remove macros that will interfere with the definitions below. */ #undef Tcl_Alloc #undef Tcl_Free #undef Tcl_Realloc #undef Tcl_NewByteArrayObj #undef Tcl_NewDoubleObj #undef Tcl_NewListObj #undef Tcl_NewLongObj #undef Tcl_DbNewLongObj #undef Tcl_NewObj #undef Tcl_NewStringObj #undef Tcl_GetUnicode #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory #undef Tcl_SetExitProc #undef Tcl_SetPanicProc #undef TclpGetPid #undef TclStaticPackage #undef Tcl_BackgroundError #define TclStaticPackage Tcl_StaticPackage #ifdef TCL_MEM_DEBUG # define Tcl_Alloc TclpAlloc # define Tcl_Free TclpFree |
Changes to generic/tclTestProcBodyObj.c.
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
...
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
return TCL_ERROR;
}
}
return Tcl_PkgProvide(interp, packageName, packageVersion);
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestProcObjCmd --
*
................................................................................
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:
*/
|
|
|
|
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
...
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
cmdTablePtr = (isSafe) ? &safeCommands[0] : &commands[0];
for ( ; cmdTablePtr->cmdName ; cmdTablePtr++) {
if (RegisterCommand(interp, packageName, cmdTablePtr) != TCL_OK) {
return TCL_ERROR;
}
}
return Tcl_PkgProvideEx(interp, packageName, packageVersion, NULL);
}
/*
*----------------------------------------------------------------------
*
* ProcBodyTestProcObjCmd --
*
................................................................................
const char *version;
if (objc != 1) {
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
version = Tcl_PkgPresentEx(interp, packageName, packageVersion, 1, NULL);
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 generic/tclZipfs.c.
4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 |
*/
Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
Tcl_NewStringObj("::tcl::zipfs::find", -1));
Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
ZipFSTclLibraryObjCmd, NULL, NULL);
Tcl_PkgProvide(interp, "zipfs", "2.0");
}
return TCL_OK;
#else /* !HAVE_ZLIB */
ZIPFS_ERROR(interp, "no zlib available");
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
return TCL_ERROR;
#endif /* HAVE_ZLIB */
|
| |
4768 4769 4770 4771 4772 4773 4774 4775 4776 4777 4778 4779 4780 4781 4782 |
*/
Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
Tcl_NewStringObj("::tcl::zipfs::find", -1));
Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
ZipFSTclLibraryObjCmd, NULL, NULL);
Tcl_PkgProvideEx(interp, "zipfs", "2.0", NULL);
}
return TCL_OK;
#else /* !HAVE_ZLIB */
ZIPFS_ERROR(interp, "no zlib available");
Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
return TCL_ERROR;
#endif /* HAVE_ZLIB */
|
Changes to generic/tclZlib.c.
3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 |
TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");
/*
* Formally provide the package as a Tcl built-in.
*/
return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
}
/*
*----------------------------------------------------------------------
* Stubs used when a suitable zlib installation was not found during
* configure.
*----------------------------------------------------------------------
|
| |
3926 3927 3928 3929 3930 3931 3932 3933 3934 3935 3936 3937 3938 3939 3940 |
TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");
/*
* Formally provide the package as a Tcl built-in.
*/
return Tcl_PkgProvideEx(interp, "zlib", TCL_ZLIB_VERSION, NULL);
}
/*
*----------------------------------------------------------------------
* Stubs used when a suitable zlib installation was not found during
* configure.
*----------------------------------------------------------------------
|
Changes to tests/compExpr-old.test.
584 585 586 587 588 589 590 591 592 593 594 595 596 597 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
set i 123
if {[expr 0x$a(VALUE)] & 16} {
set i {}
}
|
> |
584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 |
set ::errorInfo
} -match glob -result {too few arguments for math function*
while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
catch {unset a}
set a(VALUE) ff15
set i 123
if {[expr 0x$a(VALUE)] & 16} {
set i {}
}
|
Changes to tests/expr-old.test.
937 938 939 940 941 942 943 944 945 946 947 948 949 950 |
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0o289
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
|
> |
937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 |
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0o289
list [catch {expr {$x+1}} msg] $msg
} {1 {can't use non-numeric string "0o289" as operand of "+"}}
|
Changes to tests/expr.test.
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
|
< |
12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
|
Changes to unix/tclUnixCompat.c.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
* Written by: Zoran Vasiljevic ([email protected]). * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <pwd.h> #include <grp.h> #include <errno.h> #include <string.h> /* * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ |
< < |
4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
* Written by: Zoran Vasiljevic ([email protected]). * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" #include <errno.h> #include <string.h> /* * See also: SC_BLOCKING_STYLE in unix/tcl.m4 */ |
Changes to unix/tclUnixFCmd.c.
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" #include <utime.h> #include <grp.h> #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif #endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ #ifdef HAVE_FTS #include <fts.h> |
< < |
37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH * DAMAGE. */ #include "tclInt.h" #ifndef HAVE_STRUCT_STAT_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif #endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ #ifdef HAVE_FTS #include <fts.h> |