Tcl Source Code

Check-in [27603c3b06]
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:* tests/interp.test: * generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at current scope in the target interpreter instead of at the global scope. This was an incompatibility introduced in 8.1 that is being removed. [Bug: 1153, 1556]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 27603c3b069d07d206fd8ed3627634a3c0c17550
User & Date: stanton 1999-03-26 02:24:45
Context
1999-03-26
19:13
-now all test files that skip tests by returning early (which ideally they shouldn't do) call ::t... check-in: 4c4431ec5e user: hershey tags: core-8-1-branch-old
02:24
* tests/interp.test: * generic/tclInterp.c (AliasObjCmd): Changed so aliases are invoked at current ... check-in: 27603c3b06 user: stanton tags: core-8-1-branch-old
00:29
"genWinImage.tcl" is now a bit more informative about what it created. Minor tweak to "tcl.wse.in" t... check-in: c7c062771e user: suresh tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclInterp.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
 *	and manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright (c) 1995-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: tclInterp.c,v 1.1.2.10 1999/03/14 18:56:20 stanton Exp $
 */

#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"
 
/*
................................................................................
     * in the target interp's global namespace.
     */
     
    Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &prefc, &prefv);
    cmdPtr = Tcl_NewListObj(prefc, prefv);
    Tcl_ListObjReplace(NULL, cmdPtr, prefc, 0, objc - 1, objv + 1);
    Tcl_ListObjGetElements(NULL, cmdPtr, &cmdc, &cmdv);
    result = TclObjInvokeGlobal(targetInterp, cmdc, cmdv,
	    TCL_INVOKE_NO_TRACEBACK);
    Tcl_DecrRefCount(cmdPtr);

    ((Interp *) targetInterp)->numLevels--;
    
    /*
     * Check if we are at the bottom of the stack for the target interpreter.






|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
 *	and manipulation of Tcl interpreters from within Tcl scripts.
 *
 * Copyright (c) 1995-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: tclInterp.c,v 1.1.2.11 1999/03/26 02:24:45 stanton Exp $
 */

#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"
 
/*
................................................................................
     * in the target interp's global namespace.
     */
     
    Tcl_ListObjGetElements(NULL, aliasPtr->prefixPtr, &prefc, &prefv);
    cmdPtr = Tcl_NewListObj(prefc, prefv);
    Tcl_ListObjReplace(NULL, cmdPtr, prefc, 0, objc - 1, objv + 1);
    Tcl_ListObjGetElements(NULL, cmdPtr, &cmdc, &cmdv);
    result = TclObjInvoke(targetInterp, cmdc, cmdv,
	    TCL_INVOKE_NO_TRACEBACK);
    Tcl_DecrRefCount(cmdPtr);

    ((Interp *) targetInterp)->numLevels--;
    
    /*
     * Check if we are at the bottom of the stack for the target interpreter.

Changes to tests/interp.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
2324
2325
2326
2327
2328
2329
2330


















2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
#
# Copyright (c) 1995-1996 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: interp.test,v 1.1.2.8 1999/03/24 02:49:17 hershey Exp $

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

# The set of hidden commands is platform dependent:

................................................................................

# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {
    set i [interp create]
    $i alias ns::cmd list
    $i alias ns::cmd {}
} {}



















# cleanup
foreach i [interp slaves] {
  interp delete $i
}
::tcltest::cleanupTests
return


















|







 







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







<
<
<
<
<
<
<
<
<
<
<
<
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355












#
# Copyright (c) 1995-1996 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: interp.test,v 1.1.2.9 1999/03/26 02:24:46 stanton Exp $

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

# The set of hidden commands is platform dependent:

................................................................................

# This test dumps core in Tcl 8.0.3!
test interp-30.1 {deletion of aliases inside namespaces} {
    set i [interp create]
    $i alias ns::cmd list
    $i alias ns::cmd {}
} {}

test interp-31.1 {alias invocation scope} {
    proc mySet {varName value} {
	upvar 1 $varName localVar
	set localVar $value
    }

    interp alias {} myNewSet {} mySet
    proc testMyNewSet {value} {
	myNewSet a $value
	return $a
    }
    catch {unset a}
    set result [testMyNewSet "ok"]
    rename testMyNewSet {}
    rename mySet {}
    set result
} ok

# cleanup
foreach i [interp slaves] {
  interp delete $i
}
::tcltest::cleanupTests
return