Tcl Source Code

Check-in [08e3b17c95]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:Fix for [1eb488b699d74e0], double free when deleting namespace containing the origin routine for some imported routine.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-3422267ed6b79922
Files: files | file ages | folders
SHA3-256: 08e3b17c955f062d2cf4282ccd6f2216fd9ee1c660c4ea45256ceeb7d8de773c
User & Date: pooryorick 2020-08-16 14:50:38.803
References
2020-08-16
17:43 • Ticket [3422267ed6] segmentation fault from deleting the the target of an imported alias during a trace on the target of the alias status still Open with 3 other changes artifact: db5108fc04 user: pooryorick
14:51 • Ticket [1eb488b699] double free when deleting namespace containing the origin routine for some imported routine status still Open with 3 other changes artifact: d13834a175 user: pooryorick
Context
2020-08-17
16:26
Add missing reference account for Command structures check-in: 7b1dfc9790 user: pooryorick tags: bug-3422267ed6b79922
2020-08-16
14:50
Fix for [1eb488b699d74e0], double free when deleting namespace containing the origin routine for som... check-in: 08e3b17c95 user: pooryorick tags: bug-3422267ed6b79922
12:09
merge core-8-branch check-in: 051b01373f user: pooryorick tags: bug-3422267ed6b79922
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclBasic.c.
︙︙
2753
2754
2755
2756
2757
2758
2759


2760


2761
2762
2763
2764
2765
2766
2767
2768
2769
2770

	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)ckalloc(sizeof(Command));


    Tcl_SetHashValue(hPtr, cmdPtr);


    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;
    cmdPtr->refCount = 1;
    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
    cmdPtr->deleteProc = deleteProc;








>
>

>
>


<








2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766

2767
2768
2769
2770
2771
2772
2773

	 * need the info will be soon enough.
	 */

	TclInvalidateNsCmdLookup(nsPtr);
	TclInvalidateNsPath(nsPtr);
    }
    cmdPtr = (Command *)ckalloc(sizeof(Command));
    cmdPtr->refCount = 1;

    Tcl_SetHashValue(hPtr, cmdPtr);
	cmdPtr->refCount++;

    cmdPtr->hPtr = hPtr;
    cmdPtr->nsPtr = nsPtr;

    cmdPtr->cmdEpoch = 0;
    cmdPtr->compileProc = NULL;
    cmdPtr->objProc = proc;
    cmdPtr->objClientData = clientData;
    cmdPtr->proc = TclInvokeObjectCommand;
    cmdPtr->clientData = cmdPtr;
    cmdPtr->deleteProc = deleteProc;
︙︙
Changes to generic/tclNamesp.c.
︙︙
8
9
10
11
12
13
14

15
16
17
18
19
20
21

 *	special-purpose commands and variables for packages.
 *
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2002-2005 Donal K. Fellows.
 * Copyright (c) 2006 Neil Madden.

 * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
 *
 * Originally implemented by
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   [email protected]
 *








>








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

 *	special-purpose commands and variables for packages.
 *
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 2002-2005 Donal K. Fellows.
 * Copyright (c) 2006 Neil Madden.
 * Copyright (c) 2018-2020 Nathan Coulter
 * Contributions from Don Porter, NIST, 2007. (not subject to US copyright)
 *
 * Originally implemented by
 *   Michael J. McLennan
 *   Bell Labs Innovations for Lucent Technologies
 *   [email protected]
 *
︙︙
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982

}

/*
 *----------------------------------------------------------------------
 *
 * TclGetOriginalCommand --
 *
 *	An imported command is created in an namespace when a "real" command
 *	is imported from another namespace. If the specified command is an
 *	imported command, this function returns the original command it refers
 *	to.
 *
 * Results:
 *	If the command was imported into a sequence of namespaces a, b,...,n
 *	where each successive namespace just imports the command from the
 *	previous namespace, this function returns the Tcl_Command token in the
 *	first namespace, a. Otherwise, if the specified command is not an
 *	imported command, the function returns NULL.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclGetOriginalCommand(
    Tcl_Command command)	/* The imported command for which the original
				 * command should be returned. */
{
    Command *cmdPtr = (Command *) command;
    ImportedCmdData *dataPtr;

    if (cmdPtr->deleteProc != DeleteImportedCmd) {
	return NULL;
    }








|
|
|
<


<
<
<
<
<









|
<








1948
1949
1950
1951
1952
1953
1954
1955
1956
1957

1958
1959





1960
1961
1962
1963
1964
1965
1966
1967
1968
1969

1970
1971
1972
1973
1974
1975
1976

}

/*
 *----------------------------------------------------------------------
 *
 * TclGetOriginalCommand --
 *
 *	Returns the routine that an imported routine references, traversing any
 *	intermediate imported routines to find the origin routine. Returns NULL
 *	if the given routine is not imported.

 *
 * Results:





 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclGetOriginalCommand(
    Tcl_Command command)	/* A routine to find the original routine for */

{
    Command *cmdPtr = (Command *) command;
    ImportedCmdData *dataPtr;

    if (cmdPtr->deleteProc != DeleteImportedCmd) {
	return NULL;
    }
︙︙
2077
2078
2079
2080
2081
2082
2083
2084

2085
2086
2087
2088
2089
2090
2091

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    TclCleanupCommandMacro(refPtr->importedCmdPtr);
	    ckfree(refPtr);
	    TclCleanupCommandMacro(selfPtr)

	    ckfree(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");








|
>








2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086

	    if (prevPtr == NULL) { /* refPtr is first in list. */
		realCmdPtr->importRefPtr = refPtr->nextPtr;
	    } else {
		prevPtr->nextPtr = refPtr->nextPtr;
	    }
	    TclCleanupCommandMacro(refPtr->importedCmdPtr);
	    ckfree(refPtr);
	    TclCleanupCommandMacro(selfPtr);
	    TclCleanupCommandMacro(realCmdPtr);
	    ckfree(dataPtr);
	    return;
	}
	prevPtr = refPtr;
    }

    Tcl_Panic("DeleteImportedCmd: did not find cmd in real cmd's list of import references");
︙︙
Changes to tests/namespace.test.
︙︙
530
531
532
533
534
535
536




















537
538
539
540
541
542
543

} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::link2::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *





















test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563

} -body {
    namespace eval my \
	    [list namespace forget [namespace current]::link2::cmd]
    my::cmd
} -cleanup {
    namespace delete origin link link2 my
} -returnCodes error -match glob -result *


test namespace-10.10 {
	reference counting of target of imported command

	should not produce a memory error in Tcl built with -DPURIFY
	--enable-symbols
} -body {
    namespace eval test_ns_export {
	namespace export cmd1
	proc cmd1 args {}
    }
    namespace eval test_ns_import {
	namespace import [namespace parent]::test_ns_export::cmd1
    }
    proc test_ns_export::cmd1 args {}
    catch {namespace delete {*}[namespace children :: test_ns_export]}
    return success
} -result success


test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
    catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
    namespace eval test_ns_export {
        namespace export cmd1
        proc cmd1 {args} {return "cmd1: $args"}
︙︙
This page was generated in about 0.046s by Fossil 2.26 [54cfac8c84] 2025-03-21 15:26:53