Tcl Source Code

Check-in [26b1008bda]
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:Created branch scriptics-sc-2-0-b2-synthetic
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | scriptics-sc-2-0-b2 | scriptics-sc-2-0-b2-synthetic
Files: files | file ages | folders
SHA1: 26b1008bda099644cc4a85ebc28747943fe6dc25
User & Date: cvs2fossil 2000-03-30 04:36:09
Context
2000-03-30
04:36
Created branch scriptics-sc-2-0-b2-synthetic Closed-Leaf check-in: 26b1008bda user: cvs2fossil tags: scriptics-sc-2-0-b2, scriptics-sc-2-0-b2-synthetic
04:36
* generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup more aware of TCL_BYTECODE_PREC...
check-in: 95a7cc2831 user: hobbs tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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
2000-03-29  Jeff Hobbs  <[email protected]>

	* generic/tclCompile.c (TclCleanupByteCode): made ByteCode cleanup
	more aware of TCL_BYTECODE_PRECOMPILED flagged structs (gen'd by
	tbcload), to correctly clean them up.

	* generic/tclClock.c (FormatClock): moved check for empty format
	earlier, commented 0 result return value

2000-03-29  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Removed an unnecessary fileevent
	statement from the error processing part of the Write method.
	Also, fixed two potential memory leaks in wait and reset, in which
	the state array wasn't being unset before throwing an exception.
	Prior to this version, Brent checked in a fix to catch a
	fileevent statement that was sometimes causing a stack trace when
	geturl was called with -timeout.  I believe Brent's fix is
	necessary because TLS closes bad sockets for secure connections,
	and the fileevent was trying to act on a socket that no longer
	existed.

2000-03-27  Jeff Hobbs  <[email protected]>

	* tests/httpd: removed unnecessary 'puts stderr "Post Dispatch"'

	* tests/namespace.test:
	* generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the
	export list so only one instance of each export pattern would
	exist in the list.

	* generic/tclExecute.c (TclExecuteByteCode): optimized case for
	the empty string in ==/!= comparisons

2000-03-27  Eric Melski  <[email protected]>

	* unix/tclUnixChan.c: Added (off_t) type casts in lseek() call
	[Bug: 4409].

	* unix/tclLoadAout.c: 
	* unix/tclUnixPipe.c: Added (off_t) type casts in lseek() calls
	[Bug: 4410].

2000-03-22  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Fixed a bug where string query data
	that was bigger than queryblocksize would get duplicate characters
	at block boundaries.

2000-03-22  Sandeep Tamhankar <[email protected]>

	* library/http2.1/http.tcl: Fixed bug 4463, where we were getting
	a stack trace if we tried to publish a project to a good host but
	a port where there was no server listening.  It turned out the
	problem was a stray fileevent that needed to be cleared.  Also,
	fixed a bug where http::code could stack trace if called on a bad
	token (one which didn't represent a successful geturl) by adding
	an http element to the state array in geturl.

2000-03-21  Eric Melski  <[email protected]>

	* tests/clock.test: Modified some tests that were not robust with
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


|





|
|
|
|

















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19










































2000-03-22  Sandeep Tamhankar <[email protected]>

        * library/http2.1/http.tcl: Fixed a bug where string query data
	that was bigger than queryblocksize would get duplicate characters
	at block boundaries.

2000-03-22  Sandeep Tamhankar <[email protected]>

        * library/http2.1/http.tcl: Fixed bug 4463, where we were getting
        a stack trace if we tried to publish a project to a good host but
        a port where there was no server listening.  It turned out the
        problem was a stray fileevent that needed to be cleared.  Also,
	fixed a bug where http::code could stack trace if called on a bad
	token (one which didn't represent a successful geturl) by adding
	an http element to the state array in geturl.

2000-03-21  Eric Melski  <[email protected]>

	* tests/clock.test: Modified some tests that were not robust with

Changes to generic/tclClock.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
...
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
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.9 2000/03/30 04:36:11 hobbs Exp $
 */

#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"

/*
................................................................................
    if (!calledTzset) {
        tzset();
        calledTzset = 1;
    }
    Tcl_MutexUnlock(&clockMutex);
#endif

    /*
     * If the user gave us -format "", just return now
     */
    if (*format == '\0') {
	return TCL_OK;
    }

#ifndef HAVE_TM_ZONE
    /*
     * This is a kludge for systems not having the timezone string in
     * struct tm.  No matter what was specified, they use the local
     * timezone string.
     */

................................................................................
        } else {
            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        }
        timezone = savedTimeZone;
        tzset();
    }
#endif

    if (result == 0) {
	/*
	 * A zero return is the error case (can also mean the strftime
	 * didn't get enough space to write into).  We know it doesn't
	 * mean that we wrote zero chars because the check for an empty
	 * format string is above.
	 */
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad format string \"", format, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1);
    Tcl_DStringFree(&buffer);
    return TCL_OK;
}







|







 







<
<
<
<
<
<
<







 







<
|
<
<
<
<
<
<










7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
278
279
280
281
282
283
284







285
286
287
288
289
290
291
...
336
337
338
339
340
341
342

343






344
345
346
347
348
349
350
351
352
353
 *
 * Copyright 1991-1995 Karl Lehenbauer and Mark Diekhans.
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclClock.c,v 1.8 2000/01/26 03:37:40 hobbs Exp $
 */

#include "tcl.h"
#include "tclInt.h"
#include "tclPort.h"

/*
................................................................................
    if (!calledTzset) {
        tzset();
        calledTzset = 1;
    }
    Tcl_MutexUnlock(&clockMutex);
#endif








#ifndef HAVE_TM_ZONE
    /*
     * This is a kludge for systems not having the timezone string in
     * struct tm.  No matter what was specified, they use the local
     * timezone string.
     */

................................................................................
        } else {
            Tcl_UnsetVar2(interp, "env", "TZ", TCL_GLOBAL_ONLY);
        }
        timezone = savedTimeZone;
        tzset();
    }
#endif

    if ((result == 0) && (*format != '\0')) {






	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"bad format string \"", format, "\"", (char *) NULL);
	return TCL_ERROR;
    }

    Tcl_SetStringObj(Tcl_GetObjResult(interp), buffer.string, -1);
    Tcl_DStringFree(&buffer);
    return TCL_OK;
}

Changes to generic/tclCompile.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
 *	sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.c,v 1.20 2000/03/30 04:36:11 hobbs Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Table of all AuxData types.
................................................................................

    /*
     * A single heap object holds the ByteCode structure and its code,
     * object, command location, and auxiliary data arrays. This means we
     * only need to 1) decrement the ref counts of the LiteralEntry's in
     * its literal array, 2) call the free procs for the auxiliary data
     * items, and 3) free the ByteCode structure's heap object.
     *
     * The case for TCL_BYTECODE_PRECOMPILED (precompiled ByteCodes,
     * like those generated from tbcload) is special, as they doesn't
     * make use of the global literal table.  They instead maintain
     * private references to their literals which must be decremented.
     */

    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
	register Tcl_Obj *objPtr;
 
	objArrayPtr = codePtr->objArrayPtr;
	for (i = 0;  i < numLitObjects;  i++) {
	    objPtr = *objArrayPtr;
	    if (objPtr) {
		Tcl_DecrRefCount(objPtr);
	    }
	    objArrayPtr++;
	}
	codePtr->numLitObjects = 0;
    } else if (interp != NULL) {
	/*
	 * If the interp has already been freed, then Tcl will have already 
	 * forcefully released all the literals used by ByteCodes compiled
	 * with respect to that interp.
	 */
	 
	objArrayPtr = codePtr->objArrayPtr;






|







 







|
<
<
<
<
<

<
<
<
<
<
<
<
<
<
<
<
<
|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
549
550
551
552
553
554
555
556





557












558
559
560
561
562
563
564
565
 *	sequence of instructions ("bytecodes"). 
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclCompile.c,v 1.19 1999/12/12 02:26:41 hobbs Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

/*
 * Table of all AuxData types.
................................................................................

    /*
     * A single heap object holds the ByteCode structure and its code,
     * object, command location, and auxiliary data arrays. This means we
     * only need to 1) decrement the ref counts of the LiteralEntry's in
     * its literal array, 2) call the free procs for the auxiliary data
     * items, and 3) free the ByteCode structure's heap object.
     */


















    if (interp != NULL) {
	/*
	 * If the interp has already been freed, then Tcl will have already 
	 * forcefully released all the literals used by ByteCodes compiled
	 * with respect to that interp.
	 */
	 
	objArrayPtr = codePtr->objArrayPtr;

Changes to generic/tclExecute.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.10 2000/03/27 22:18:55 hobbs Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#ifdef NO_FLOAT_H
#   include "../compat/float.h"
................................................................................
		double d2 = 0.0;   /* Init. avoids compiler warning. */
		long iResult = 0;  /* Init. avoids compiler warning. */

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;

		/*
		 * We only want to coerce numeric validation if
		 * neither type is NULL.  A NULL type means the arg is
		 * essentially an empty object ("", {} or [list]).
		 */
		if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL))
			|| (valuePtr->bytes && (valuePtr->length == 0)))
			|| (((t2Ptr == NULL) && (value2Ptr->bytes == NULL))
				|| (value2Ptr->bytes && (value2Ptr->length == 0))))) {
		    if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
			s1 = Tcl_GetStringFromObj(valuePtr, &length);
			if (TclLooksLikeInt(s1, length)) {
			    (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    valuePtr, &i);
			} else {
			    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    valuePtr, &d1);
			}
			t1Ptr = valuePtr->typePtr;
		    }
		    if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
			s2 = Tcl_GetStringFromObj(value2Ptr, &length);
			if (TclLooksLikeInt(s2, length)) {
			    (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				    value2Ptr, &i2);
			} else {
			    (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				    value2Ptr, &d2);
			}
			t2Ptr = value2Ptr->typePtr;
		    }
		}
		if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
		        || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
		    /*
		     * One operand is not numeric. Compare as strings.
		     */
		    int cmpValue;
		    s1 = Tcl_GetString(valuePtr);






|







 







|
<
<
<
<
<
<
<
<
<
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1775
1776
1777
1778
1779
1780
1781
1782









1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
 *	commands.
 *
 * Copyright (c) 1996-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclExecute.c,v 1.9 1999/12/12 02:26:42 hobbs Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"

#ifdef NO_FLOAT_H
#   include "../compat/float.h"
................................................................................
		double d2 = 0.0;   /* Init. avoids compiler warning. */
		long iResult = 0;  /* Init. avoids compiler warning. */

		value2Ptr = POP_OBJECT();
		valuePtr  = POP_OBJECT();
		t1Ptr = valuePtr->typePtr;
		t2Ptr = value2Ptr->typePtr;
		









		if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
		    s1 = Tcl_GetStringFromObj(valuePtr, &length);
		    if (TclLooksLikeInt(s1, length)) {
			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				valuePtr, &i);
		    } else {
			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				valuePtr, &d1);
		    }
		    t1Ptr = valuePtr->typePtr;
		}
		if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
		    s2 = Tcl_GetStringFromObj(value2Ptr, &length);
		    if (TclLooksLikeInt(s2, length)) {
			(void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
				value2Ptr, &i2);
		    } else {
			(void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
				value2Ptr, &d2);
		    }
		    t2Ptr = value2Ptr->typePtr;
		}

		if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
		        || ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
		    /*
		     * One operand is not numeric. Compare as strings.
		     */
		    int cmpValue;
		    s1 = Tcl_GetString(valuePtr);

Changes to generic/tclNamesp.c.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.17 2000/03/27 22:18:56 hobbs Exp $
 */

#include "tclInt.h"

/*
 * Flag passed to TclGetNamespaceForQualName to indicate that it should
 * search for a namespace rather than a command or variable inside a
................................................................................

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	        "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace",
		(char *) NULL);
	return TCL_ERROR;
    }

    /*
     * Make sure that we don't already have the pattern in the array
     */
    if (nsPtr->exportArrayPtr != NULL) {
	for (i = 0;  i < nsPtr->numExportPatterns;  i++) {
	    if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
		/*
		 * The pattern already exists in the list
		 */
		return TCL_OK;
	    }
	}
    }

    /*
     * Make sure there is room in the namespace's pattern array for the
     * new pattern.
     */







|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
...
949
950
951
952
953
954
955














956
957
958
959
960
961
962
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   [email protected]
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclNamesp.c,v 1.16 2000/01/26 21:36:35 ericm Exp $
 */

#include "tclInt.h"

/*
 * Flag passed to TclGetNamespaceForQualName to indicate that it should
 * search for a namespace rather than a command or variable inside a
................................................................................

    if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
	        "invalid export pattern \"", pattern,
		"\": pattern can't specify a namespace",
		(char *) NULL);
	return TCL_ERROR;














    }

    /*
     * Make sure there is room in the namespace's pattern array for the
     * new pattern.
     */

Changes to tests/httpd.

102
103
104
105
106
107
108

109
110
111
112
113
114
115
	}
	1,query,POST	{
	    append data(query) $line
	    if {$data(length) <= 0} {
		set data(length) $data(length_orig)
		httpdRespond $sock
	    }

	}
	default {
	    if [eof $sock] {
		httpd_log $sock Error "unexpected eof on <$data(url)> request"
	    } else {
		httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
	    }






>







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
	}
	1,query,POST	{
	    append data(query) $line
	    if {$data(length) <= 0} {
		set data(length) $data(length_orig)
		httpdRespond $sock
	    }
puts stderr "Post Dispatch"
	}
	default {
	    if [eof $sock] {
		httpd_log $sock Error "unexpected eof on <$data(url)> request"
	    } else {
		httpd_log $sock Error "unhandled state <$state> fetching <$data(url)>"
	    }

Changes to tests/namespace.test.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: namespace.test,v 1.10 2000/03/27 22:19:14 hobbs Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

# Clear out any namespaces called test_ns_*
................................................................................
        namespace export cmd1 cmd3
    }
    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
} {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
    namespace eval test_ns_1 {
        namespace export
    }
} {cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }






|







 







|



|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
...
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: namespace.test,v 1.9 2000/01/26 21:36:36 ericm Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

# Clear out any namespaces called test_ns_*
................................................................................
        namespace export cmd1 cmd3
    }
    namespace eval test_ns_2 {
        namespace import -force ::test_ns_1::*
    }
    list [info commands test_ns_2::*] [test_ns_2::cmd3 hello]
} {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
test namespace-26.6 {NamespaceExportCmd, no patterns means return export list} {
    namespace eval test_ns_1 {
        namespace export
    }
} {cmd1 cmd1 cmd3}
test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
    namespace eval test_ns_1 {
        namespace export -clear cmd4
    }
    namespace eval test_ns_2 {
        namespace import ::test_ns_1::*
    }

Changes to unix/tcl.spec.

1
2
3
4
5
6
7
8
..
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
# $Id: tcl.spec,v 1.2 2000/03/24 23:15:29 ericm Exp $
# This file is the basis for a binary Tcl RPM for Linux.

%define version 8.3.0
%define directory /usr/local

Summary: Tcl scripting language development environment
Name: tcl
................................................................................

# to create the tcl files list, comment out tk in the install section above,
# then run "rpm -bi" then do a find from the build root directory,
# and remove the files in specific directories which suffice by themselves,
# then to create the files list for tk, uncomment tk, comment out tcl,
# then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find,
# and remove the files in specific directories which suffice by themselves.
%files
%defattr(-,root,root)
%{directory}/lib
%{directory}/bin
%{directory}/include
%{directory}/man/man1
%{directory}/man/man3
%{directory}/man/mann
|







 







|




|
<
<
1
2
3
4
5
6
7
8
..
39
40
41
42
43
44
45
46
47
48
49
50
51


# $Id: tcl.spec,v 1.1 2000/02/14 22:40:56 ericm Exp $
# This file is the basis for a binary Tcl RPM for Linux.

%define version 8.3.0
%define directory /usr/local

Summary: Tcl scripting language development environment
Name: tcl
................................................................................

# to create the tcl files list, comment out tk in the install section above,
# then run "rpm -bi" then do a find from the build root directory,
# and remove the files in specific directories which suffice by themselves,
# then to create the files list for tk, uncomment tk, comment out tcl,
# then rm -rf $RPM_BUILD_ROOT then rpm --short-circuit -bi then redo a find,
# and remove the files in specific directories which suffice by themselves.
%files -n tcl
%defattr(-,root,root)
%{directory}/lib
%{directory}/bin
%{directory}/include
%{directory}/man


Changes to unix/tclLoadAout.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This work was supported in part by the ARPA Manufacturing Automation
 * and Design Engineering (MADE) Initiative through ARPA contract
 * F33615-94-C-4400.
 *
 * RCS: @(#) $Id: tclLoadAout.c,v 1.4 2000/03/27 18:34:32 ericm Exp $
 */

#include "tclInt.h"
#include <fcntl.h>
#ifdef HAVE_EXEC_AOUT_H
#   include <sys/exec_aout.h>
#endif
................................................................................

  (void) brk (startAddress + relocatedSize);

  /* Seek to the start of the module's text */

#if defined(__mips) || defined(mips)
  status = lseek (relocatedFd,
	  (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
	  SEEK_SET);
#else
  status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET);
#endif
  if (status < 0) {
    goto ioError;
  }

  /* Read in the module's text and data */







|







 







|
|

|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * This work was supported in part by the ARPA Manufacturing Automation
 * and Design Engineering (MADE) Initiative through ARPA contract
 * F33615-94-C-4400.
 *
 * RCS: @(#) $Id: tclLoadAout.c,v 1.3 1999/04/16 00:48:04 stanton Exp $
 */

#include "tclInt.h"
#include <fcntl.h>
#ifdef HAVE_EXEC_AOUT_H
#   include <sys/exec_aout.h>
#endif
................................................................................

  (void) brk (startAddress + relocatedSize);

  /* Seek to the start of the module's text */

#if defined(__mips) || defined(mips)
  status = lseek (relocatedFd,
		  N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
		  SEEK_SET);
#else
  status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
#endif
  if (status < 0) {
    goto ioError;
  }

  /* Read in the module's text and data */

Changes to unix/tclUnixChan.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixChan.c,v 1.14 2000/03/27 18:34:32 ericm Exp $
 */

#include	"tclInt.h"	/* Internal definitions for Tcl. */
#include	"tclPort.h"	/* Portability features for Tcl. */

/*
 * sys/ioctl.h has already been included by tclPort.h.  Including termios.h
................................................................................
                                                 * one of SEEK_START,
                                                 * SEEK_SET or SEEK_END. */
    int *errorCodePtr;				/* To store error code. */
{
    FileState *fsPtr = (FileState *) instanceData;
    int newLoc;

    newLoc = lseek(fsPtr->fd, (off_t) offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}
 
/*
 *----------------------------------------------------------------------






|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixChan.c,v 1.13 2000/01/26 03:38:00 hobbs Exp $
 */

#include	"tclInt.h"	/* Internal definitions for Tcl. */
#include	"tclPort.h"	/* Portability features for Tcl. */

/*
 * sys/ioctl.h has already been included by tclPort.h.  Including termios.h
................................................................................
                                                 * one of SEEK_START,
                                                 * SEEK_SET or SEEK_END. */
    int *errorCodePtr;				/* To store error code. */
{
    FileState *fsPtr = (FileState *) instanceData;
    int newLoc;

    newLoc = lseek(fsPtr->fd, offset, mode);

    *errorCodePtr = (newLoc == -1) ? errno : 0;
    return newLoc;
}
 
/*
 *----------------------------------------------------------------------

Changes to unix/tclUnixPipe.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPipe.c,v 1.8 2000/03/27 18:34:32 ericm Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following macros convert between TclFile's and fd's.  The conversion
................................................................................

	/*
	 * If the file is being opened for writing, seek to the end
	 * so we can append to any data already in the file.
	 */

	if (mode & O_WRONLY) {
	    lseek(fd, (off_t) 0, SEEK_END);
	}

	/*
	 * Increment the fd so it can't be 0, which would conflict with
	 * the NULL return for errors.
	 */

................................................................................
    unlink(fileName);					/* INTL: Native. */

    if (contents != NULL) {
	if (write(fd, contents, strlen(contents)) == -1) {
	    close(fd);
	    return NULL;
	}
	lseek(fd, (off_t) 0, SEEK_SET);
    }
    return MakeFile(fd);
}
 
/*
 *----------------------------------------------------------------------
 *






|







 







|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
 *
 * Copyright (c) 1991-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixPipe.c,v 1.7 1999/12/12 02:27:20 hobbs Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * The following macros convert between TclFile's and fd's.  The conversion
................................................................................

	/*
	 * If the file is being opened for writing, seek to the end
	 * so we can append to any data already in the file.
	 */

	if (mode & O_WRONLY) {
	    lseek(fd, 0, SEEK_END);
	}

	/*
	 * Increment the fd so it can't be 0, which would conflict with
	 * the NULL return for errors.
	 */

................................................................................
    unlink(fileName);					/* INTL: Native. */

    if (contents != NULL) {
	if (write(fd, contents, strlen(contents)) == -1) {
	    close(fd);
	    return NULL;
	}
	lseek(fd, 0, SEEK_SET);
    }
    return MakeFile(fd);
}
 
/*
 *----------------------------------------------------------------------
 *