Tcl Source Code

Check-in [3e4fa90a00]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:* tests/parse.test: * generic/tclParse.c: Fixed crash due to multiple frees in parser during error cleanup when parsing commands with more tokens than will fit in the static area of the parse structure. [Bug: 1681]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 3e4fa90a0063d5c024e63cae2c8aa0a81b2bdde6
User & Date: stanton 1999-04-01 21:56:14
Context
1999-04-01
21:58
* generic/tclInt.h: Removed duplicate declarations.

* generic/tclInt.decls: * generic/tcl.decls: Ad... check-in: 9f787d9a6d user: stanton tags: core-8-1-branch-old

21:56
* tests/parse.test: * generic/tclParse.c: Fixed crash due to multiple frees in parser during error c... check-in: 3e4fa90a00 user: stanton tags: core-8-1-branch-old
21:56
* tests/registry.test: * win/tclWinReg.c: Internationalized the registry code. It now uses Unicode ... check-in: 83ad188bce user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclParse.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
476
477
478
479
480
481
482

483
484
485
486
487
488
489
...
692
693
694
695
696
697
698

699
700
701
702
703
704
705
...
728
729
730
731
732
733
734

735
736
737
738
739
740
741
....
1729
1730
1731
1732
1733
1734
1735

1736
1737
1738
1739
1740
1741
1742
....
1968
1969
1970
1971
1972
1973
1974

1975
1976
1977
1978
1979
1980
1981
....
2059
2060
2061
2062
2063
2064
2065

2066
2067
2068
2069
2070
2071
2072
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclParse.c,v 1.1.2.10 1999/03/10 06:49:20 stanton Exp $
 */

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

/*
 * The following table provides parsing information about each possible
................................................................................
    string[numBytes] = (char) savedChar;
    return TCL_OK;

    error:
    string[numBytes] = (char) savedChar;
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
    if (parsePtr->commandStart == NULL) {
	parsePtr->commandStart = string;
    }
    parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
    return TCL_ERROR;
}
................................................................................
void
Tcl_FreeParse(parsePtr)
    Tcl_Parse *parsePtr;	/* Structure that was filled in by a
				 * previous call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclExpandTokenArray --
................................................................................

    newCount = parsePtr->tokensAvailable*2;
    newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
    memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
	    (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
    parsePtr->tokenPtr = newPtr;
    parsePtr->tokensAvailable = newCount;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    tokenPtr->size = 1;
    tokenPtr->numComponents = 0;
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	*termPtr = src+1;
    }
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	*termPtr = (parsePtr->term + 1);
    }
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);

    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *






|







 







>







 







>







 







>







 







>







 







>







 







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
...
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
...
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
....
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
....
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
....
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
 *
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclParse.c,v 1.1.2.11 1999/04/01 21:56:14 stanton Exp $
 */

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

/*
 * The following table provides parsing information about each possible
................................................................................
    string[numBytes] = (char) savedChar;
    return TCL_OK;

    error:
    string[numBytes] = (char) savedChar;
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
    if (parsePtr->commandStart == NULL) {
	parsePtr->commandStart = string;
    }
    parsePtr->commandSize = parsePtr->term - parsePtr->commandStart;
    return TCL_ERROR;
}
................................................................................
void
Tcl_FreeParse(parsePtr)
    Tcl_Parse *parsePtr;	/* Structure that was filled in by a
				 * previous call to Tcl_ParseCommand. */
{
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclExpandTokenArray --
................................................................................

    newCount = parsePtr->tokensAvailable*2;
    newPtr = (Tcl_Token *) ckalloc((unsigned) (newCount * sizeof(Tcl_Token)));
    memcpy((VOID *) newPtr, (VOID *) parsePtr->tokenPtr,
	    (size_t) (parsePtr->tokensAvailable * sizeof(Tcl_Token)));
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
    parsePtr->tokenPtr = newPtr;
    parsePtr->tokensAvailable = newCount;
}
 
/*
 *----------------------------------------------------------------------
................................................................................
    tokenPtr->size = 1;
    tokenPtr->numComponents = 0;
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	*termPtr = src+1;
    }
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	*termPtr = (parsePtr->term + 1);
    }
    return TCL_OK;

    error:
    if (parsePtr->tokenPtr != parsePtr->staticTokens) {
	ckfree((char *) parsePtr->tokenPtr);
	parsePtr->tokenPtr = parsePtr->staticTokens;
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to tests/parse.test.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
137
138
139
140
141
142
143







144
145
146
147
148
149
150
#
# 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: parse.test,v 1.1.2.11 1999/03/26 19:14:03 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testparser] == {}} {
    puts "This application hasn't been compiled with the \"testparser\""
................................................................................
} {1 {extra characters after close-brace} {extra characters after close-brace
    (remainder of script: "x")
    invoked from within
"testparser {foo {bar}x} 0"}}
test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} {
    testparser "foo {bar}\\\nx" 0
} {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}








test parse-6.1 {ParseTokens procedure, empty word} {
    testparser {""} 0
} {- {""} 1 simple {""} 1 text {} 0 {}}
test parse-6.2 {ParseTokens procedure, simple range} {
    testparser {"abc$x.e"} 0
} {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}






|







 







>
>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
#
# 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: parse.test,v 1.1.2.12 1999/04/01 21:56:15 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testparser] == {}} {
    puts "This application hasn't been compiled with the \"testparser\""
................................................................................
} {1 {extra characters after close-brace} {extra characters after close-brace
    (remainder of script: "x")
    invoked from within
"testparser {foo {bar}x} 0"}}
test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace} {
    testparser "foo {bar}\\\nx" 0
} {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} {
    # This test is designed to catch bug 1681.
    list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $errorInfo
} "1 {missing \"} {missing \"
    (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\")
    invoked from within
\"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}"

test parse-6.1 {ParseTokens procedure, empty word} {
    testparser {""} 0
} {- {""} 1 simple {""} 1 text {} 0 {}}
test parse-6.2 {ParseTokens procedure, simple range} {
    testparser {"abc$x.e"} 0
} {- {"abc$x.e"} 1 word {"abc$x.e"} 4 text abc 0 variable {$x} 1 text x 0 text .e 0 {}}