Tcl Source Code

Check-in [df44cd3e16]
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:
TIP #330 IMPLEMENTATION
* generic/tcl.h: Remove the "result" and "freeProc" fields * generic/tclBasic.c: from the default public declaration of the * generic/tclResult.c: Tcl_Interp struct. Code should no longer * generic/tclStubLib.c: be accessing these fields. Access can be * generic/tclTest.c: restored by defining USE_INTERP_RESULT, but * generic/tclUtil.c: that should only be a temporary migration aid. *** POTENTIAL INCOMPATIBILITY ***
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: df44cd3e1642fa9ed3671e02f5139276fb48a097
User & Date: dgp 2008-10-02 20:59:45
Context
2008-10-02
22:55
* tests/info.test (info-22.8): Fixed [SF Bug 2129828]. Made pattern for file containing tcltest... check-in: 1962be163c user: andreas_kupries tags: trunk
20:59
TIP #330 IMPLEMENTATION
* generic/tcl.h: Remove the "result" and "freeProc" ...
check-in: df44cd3e16 user: dgp tags: trunk, potential incompatibility
19:18
forgot one missing unmatched font change check-in: c1dd492734 user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.













1
2
3
4
5
6
7











2008-10-02  Joe Mistachkin  <[email protected]>

	* doc/info.n: Fix unmatched font change.
	* doc/tclvars.n: Fix unmatched font change.
	* doc/variable.n: Fix unmatched font change.
	* tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
	[Bug 1934272]
>
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
2008-10-02  Don Porter  <[email protected]>

	TIP #330 IMPLEMENTATION

	* generic/tcl.h:	Remove the "result" and "freeProc" fields
	* generic/tclBasic.c:	from the default public declaration of the
	* generic/tclResult.c:	Tcl_Interp struct.  Code should no longer
	* generic/tclStubLib.c:	be accessing these fields.  Access can be
	* generic/tclTest.c:	restored by defining USE_INTERP_RESULT, but
	* generic/tclUtil.c:	that should only be a temporary migration aid.
	*** POTENTIAL INCOMPATIBILITY ***

2008-10-02  Joe Mistachkin  <[email protected]>

	* doc/info.n: Fix unmatched font change.
	* doc/tclvars.n: Fix unmatched font change.
	* doc/variable.n: Fix unmatched font change.
	* tools/man2help2.tcl: Integrated patch from Harald Oehlmann.
	[Bug 1934272]

Changes to generic/tcl.h.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
454
455
456
457
458
459
460


461
462
463
464
465
466
467
468
469
470




471
472
473
474
475
476
477
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcl.h,v 1.270 2008/09/03 05:43:31 dgp Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
................................................................................
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp {


    char *result;		/* If the last command returned a string
				 * result, this points to it. */
    void (*freeProc) (char *blockPtr);
				/* Zero means the string result is statically
				 * allocated. TCL_DYNAMIC means it was
				 * allocated with ckalloc and should be freed
				 * with ckfree. Other values give the address
				 * of function to invoke to free the result.
				 * Tcl_Eval must free it before executing next
				 * command. */




    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
} Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;






|







 







>
>










>
>
>
>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 by Scriptics Corporation.
 * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcl.h,v 1.271 2008/10/02 20:59:45 dgp Exp $
 */

#ifndef _TCL
#define _TCL

/*
 * For C++ compilers, use extern "C"
................................................................................
 *
 * Note: Tcl_ObjCmdProc functions do not directly set result and freeProc.
 * Instead, they set a Tcl_Obj member in the "real" structure that can be
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp {
    /* TIP #330: Strongly discourage extensions from using the string result. */
#ifdef USE_INTERP_RESULT
    char *result;		/* If the last command returned a string
				 * result, this points to it. */
    void (*freeProc) (char *blockPtr);
				/* Zero means the string result is statically
				 * allocated. TCL_DYNAMIC means it was
				 * allocated with ckalloc and should be freed
				 * with ckfree. Other values give the address
				 * of function to invoke to free the result.
				 * Tcl_Eval must free it before executing next
				 * command. */
#else
    char* unused3;
    void (*unused4) (char*);
#endif
    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
} Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;

Changes to generic/tclBasic.c.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
....
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
....
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 Miguel Sofer <[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: tclBasic.c,v 1.368 2008/09/28 13:46:09 msofer Exp $
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
................................................................................

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
    interp->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
................................................................................
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(interp->result, -1);
	} else {
	    iPtr->errorInfo = iPtr->objResultPtr;
	}
	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}






|







 







|







 







|







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
....
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
....
6554
6555
6556
6557
6558
6559
6560
6561
6562
6563
6564
6565
6566
6567
6568
 * Copyright (c) 2007 Daniel A. Steffen <[email protected]>
 * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 * Copyright (c) 2008 Miguel Sofer <[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: tclBasic.c,v 1.369 2008/10/02 20:59:45 dgp Exp $
 */

#include "tclInt.h"
#include "tclOOInt.h"
#include "tclCompile.h"
#include <float.h>
#include <limits.h>
................................................................................

    /*
     * Free up the result *after* deleting variables, since variable deletion
     * could have transferred ownership of the result string to Tcl.
     */

    Tcl_FreeResult(interp);
    iPtr->result = NULL;
    Tcl_DecrRefCount(iPtr->objResultPtr);
    iPtr->objResultPtr = NULL;
    Tcl_DecrRefCount(iPtr->ecVar);
    if (iPtr->errorCode) {
	Tcl_DecrRefCount(iPtr->errorCode);
	iPtr->errorCode = NULL;
    }
................................................................................
	     * The interp's string result is set, apparently by some extension
	     * making a deprecated direct write to it. That extension may
	     * expect interp->result to continue to be set, so we'll take
	     * special pains to avoid clearing it, until we drop support for
	     * interp->result completely.
	     */

	    iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
	} else {
	    iPtr->errorInfo = iPtr->objResultPtr;
	}
	Tcl_IncrRefCount(iPtr->errorInfo);
	if (!iPtr->errorCode) {
	    Tcl_SetErrorCode(interp, "NONE", NULL);
	}

Changes to generic/tclResult.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
467
468
469
470
471
472
473

474
475
476
477
478
479
480
481
482
483
484
485
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by 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: tclResult.c,v 1.48 2008/04/27 22:21:32 dkf Exp $
 */

#include "tclInt.h"

/*
 * Indices of the standard return options dictionary keys.
 */
................................................................................
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */


    if (*(interp->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return interp->result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *






|







 







>
|



|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
 *	This file contains code to manage the interpreter result.
 *
 * Copyright (c) 1997 by 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: tclResult.c,v 1.49 2008/10/02 20:59:45 dgp Exp $
 */

#include "tclInt.h"

/*
 * Indices of the standard return options dictionary keys.
 */
................................................................................
    register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
    /*
     * If the string result is empty, move the object result to the string
     * result, then reset the object result.
     */

    Interp* iPtr = (Interp*) interp;
    if (*(iPtr->result) == 0) {
	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
		TCL_VOLATILE);
    }
    return iPtr->result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetObjResult --
 *

Changes to generic/tclStubLib.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubLib.c,v 1.26 2008/04/27 22:21:32 dkf Exp $
 */

/*
 * We need to ensure that we use the stub macros so that this file contains no
 * references to any of the stub functions. This will make it possible to
 * build an extension that references Tcl_InitStubs but doesn't end up
 * including the rest of the stub functions.
................................................................................
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
	return iPtr->stubTable;
    }

    interp->result =
	    "This interpreter does not support stubs-enabled extensions.";
    interp->freeProc = TCL_STATIC;
    return NULL;
}
 
/*
 * Use our own isdigit to avoid linking to libc on windows
 */







|







 







|

|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubLib.c,v 1.27 2008/10/02 20:59:45 dgp Exp $
 */

/*
 * We need to ensure that we use the stub macros so that this file contains no
 * references to any of the stub functions. This will make it possible to
 * build an extension that references Tcl_InitStubs but doesn't end up
 * including the rest of the stub functions.
................................................................................
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
	return iPtr->stubTable;
    }

    iPtr->result =
	    "This interpreter does not support stubs-enabled extensions.";
    iPtr->freeProc = TCL_STATIC;
    return NULL;
}
 
/*
 * Use our own isdigit to avoid linking to libc on windows
 */

Changes to generic/tclTest.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
1589
1590
1591
1592
1593
1594
1595

1596
1597
1598
1599
1600
1601
1602
....
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
....
4843
4844
4845
4846
4847
4848
4849

4850
4851
4852
4853
4854
4855
4856
....
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.124 2008/08/20 13:14:41 dkf Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd
................................................................................
TestdstringCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int count;


    if (argc < 2) {
	wrongNumArgs:
	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "append") == 0) {
................................................................................
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_SetResult(interp, "short", TCL_STATIC);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
	} else if (strcmp(argv[2], "free") == 0) {
	    Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
	    strcpy(interp->result, "This is a malloc-ed string");
	} else if (strcmp(argv[2], "special") == 0) {
	    interp->result = (char *) ckalloc(100);
	    interp->result += 4;
	    interp->freeProc = SpecialFree;
	    strcpy(interp->result, "This is a specially-allocated string");
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": must be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringGetResult(interp, &dstring);
................................................................................
static int
TestsaveresultCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{

    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
................................................................................
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC: {
	int present = interp->freeProc == TestsaveresultFree;
	int called = freeCount;

	Tcl_AppendElement(interp, called ? "called" : "notCalled");
	Tcl_AppendElement(interp, present ? "present" : "missing");
	break;
    }
    case RESULT_OBJECT:






|







 







>







 







|

|
|
|
|







 







>







 







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
....
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
....
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
....
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
....
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-2000 Ajuba Solutions.
 * Copyright (c) 2003 by Kevin B. Kenny.  All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTest.c,v 1.125 2008/10/02 20:59:45 dgp Exp $
 */

#define TCL_TEST
#include "tclInt.h"

/*
 * Required for Testregexp*Cmd
................................................................................
TestdstringCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    const char **argv)		/* Argument strings. */
{
    int count;
    Interp* iPtr = (Interp*) interp;

    if (argc < 2) {
	wrongNumArgs:
	Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
	return TCL_ERROR;
    }
    if (strcmp(argv[1], "append") == 0) {
................................................................................
	}
	if (strcmp(argv[2], "staticsmall") == 0) {
	    Tcl_SetResult(interp, "short", TCL_STATIC);
	} else if (strcmp(argv[2], "staticlarge") == 0) {
	    Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
	} else if (strcmp(argv[2], "free") == 0) {
	    Tcl_SetResult(interp, (char *) ckalloc(100), TCL_DYNAMIC);
	    strcpy(iPtr->result, "This is a malloc-ed string");
	} else if (strcmp(argv[2], "special") == 0) {
	    iPtr->result = (char *) ckalloc(100);
	    iPtr->result += 4;
	    iPtr->freeProc = SpecialFree;
	    strcpy(iPtr->result, "This is a specially-allocated string");
	} else {
	    Tcl_AppendResult(interp, "bad gresult option \"", argv[2],
		    "\": must be staticsmall, staticlarge, free, or special",
		    NULL);
	    return TCL_ERROR;
	}
	Tcl_DStringGetResult(interp, &dstring);
................................................................................
static int
TestsaveresultCmd(
    ClientData dummy,		/* Not used. */
    register Tcl_Interp *interp,/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Interp* iPtr = (Interp*) interp;
    int discard, result, index;
    Tcl_SavedResult state;
    Tcl_Obj *objPtr;
    static const char *optionStrings[] = {
	"append", "dynamic", "free", "object", "small", NULL
    };
    enum options {
................................................................................
    } else {
	Tcl_RestoreResult(interp, &state);
	result = TCL_OK;
    }

    switch ((enum options) index) {
    case RESULT_DYNAMIC: {
	int present = iPtr->freeProc == TestsaveresultFree;
	int called = freeCount;

	Tcl_AppendElement(interp, called ? "called" : "notCalled");
	Tcl_AppendElement(interp, present ? "present" : "missing");
	break;
    }
    case RESULT_OBJECT:

Changes to generic/tclUtil.c.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
2061
2062
2063
2064
2065
2066
2067

2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtil.c,v 1.103 2008/08/22 18:01:00 dgp Exp $
 */

#include "tclInt.h"
#include <float.h>
#include <math.h>

/*
................................................................................

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{

    Tcl_ResetResult(interp);

    if (dsPtr->string != dsPtr->staticSpace) {
	interp->result = dsPtr->string;
	interp->freeProc = TCL_DYNAMIC;
    } else if (dsPtr->length < TCL_RESULT_SIZE) {
	interp->result = ((Interp *) interp)->resultSpace;
	strcpy(interp->result, dsPtr->string);
    } else {
	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
    }

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;






|







 







>



|
|

|
|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUtil.c,v 1.104 2008/10/02 20:59:45 dgp Exp $
 */

#include "tclInt.h"
#include <float.h>
#include <math.h>

/*
................................................................................

void
Tcl_DStringResult(
    Tcl_Interp *interp,		/* Interpreter whose result is to be reset. */
    Tcl_DString *dsPtr)		/* Dynamic string that is to become the
				 * result of interp. */
{
    Interp* iPtr = (Interp*) interp;
    Tcl_ResetResult(interp);

    if (dsPtr->string != dsPtr->staticSpace) {
	iPtr->result = dsPtr->string;
	iPtr->freeProc = TCL_DYNAMIC;
    } else if (dsPtr->length < TCL_RESULT_SIZE) {
	iPtr->result = iPtr->resultSpace;
	strcpy(iPtr->result, dsPtr->string);
    } else {
	Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
    }

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;