Tcl Source Code

Check-in [b2f37675d3]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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: b2f37675d3b8f6ead6a8924639e0427b7814f27c16a213ce8897f6c50ced40a6
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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>

This page was generated in about 0.042s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14