Tcl Source Code

Check-in [ef1faecd65]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:fixed bad pkga.so constraint
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: ef1faecd652ffc59bd0119ec87598fd448bb8104
User & Date: hershey 1999-04-07 02:38:10
Context
1999-04-07
02:46
changed nonexistent winOnly constraint to ill-named pcOnly constraint. check-in: ba41bf3793 user: hershey tags: core-8-1-branch-old
02:38
fixed bad pkga.so constraint check-in: ef1faecd65 user: hershey tags: core-8-1-branch-old
01:59
change tcltest namespace variables from matchingTests and skippingTests to match and skip.

removed ... check-in: 043d97f05e user: hershey tags: core-8-1-branch-old

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/interp.test. 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1983
1984
1985
1986
1987
1988
1989
1990

1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003

2004
2005
2006
2007
2008
2009
2010
....
2011
2012
2013
2014
2015
2016
2017
2018

2019
2020
2021
2022
2023
2024
2025
....
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068

2069
2070
2071
2072
2073
2074
2075

#
# 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.13 1999/04/07 01:59:28 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:

................................................................................
    for {set code -1} {$code<=5} {incr code} {
	lappend res [interp eval a [list catch [list Test $code] msg]]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.4 {result code transmission: invoke hidden direct} {knownBug} {

    # The known bug is that code 2 is returned, not the -code argument
    catch {interp delete a}
    interp create a
    set res {}
    interp hide a return
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a return -code $code ret$code}]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.5 {result code transmission: invoke hidden indirect} {knownBug} {

    # The known bug is that the break and continue should raise errors
    # that they are used outside a loop.
    catch {interp delete a}
    interp create a
    set res {}
    interp eval a {proc retcode {code} {return -code $code ret$code}}
    interp hide a retcode
................................................................................
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a retcode $code} msg] $msg
    }
    interp delete a
    set res
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}

test interp-26.6 {result code transmission: all combined} {knownBug} {

    # Test that all the possibles error codes from Tcl get passed
    # In both directions.  This doesn't work.
    set interp [interp create];
    proc MyTestAlias {interp args} {
	global aliasTrace;
	lappend aliasTrace $args;
	eval interp invokehidden [list $interp] $args
................................................................................
} {msg
    while executing
"MyError "some secret""
    (procedure "MyTestAlias" line 2)
    invoked from within
"test"}

test interp-26.8 {errorInfo transmission: safe interps} {knownBug} {
    # this test fails because the errorInfo is fully transmitted
    # whether the interp is safe or not. this is maybe a feature
    # and not a bug.

    set interp [interp create -safe];
    proc MyError {secret} {
	return -code error "msg"
    }
    proc MyTestAlias {interp args} {
	MyError "some secret"
    }







|







 







|
>












|
>







 







|
>







 







|

|
|
>








6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
....
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
....
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079

#
# 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.14 1999/04/07 02:38:10 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:

................................................................................
    for {set code -1} {$code<=5} {incr code} {
	lappend res [interp eval a [list catch [list Test $code] msg]]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
	{knownBug} {
    # The known bug is that code 2 is returned, not the -code argument
    catch {interp delete a}
    interp create a
    set res {}
    interp hide a return
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a return -code $code ret$code}]
    }
    interp delete a
    set res
} {-1 0 1 2 3 4 5}

test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
	{knownBug} {
    # The known bug is that the break and continue should raise errors
    # that they are used outside a loop.
    catch {interp delete a}
    interp create a
    set res {}
    interp eval a {proc retcode {code} {return -code $code ret$code}}
    interp hide a retcode
................................................................................
    for {set code -1} {$code<=5} {incr code} {
	lappend res [catch {interp invokehidden a retcode $code} msg] $msg
    }
    interp delete a
    set res
} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}

test interp-26.6 {result code transmission: all combined--bug 1637} \
	{knownBug} {
    # Test that all the possibles error codes from Tcl get passed
    # In both directions.  This doesn't work.
    set interp [interp create];
    proc MyTestAlias {interp args} {
	global aliasTrace;
	lappend aliasTrace $args;
	eval interp invokehidden [list $interp] $args
................................................................................
} {msg
    while executing
"MyError "some secret""
    (procedure "MyTestAlias" line 2)
    invoked from within
"test"}

test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
    # this test fails because the errorInfo is fully transmitted
    # whether the interp is safe or not.  The errorInfo should never
    # report data from the master interpreter because it could
    # contain sensitive information.
    set interp [interp create -safe];
    proc MyError {secret} {
	return -code error "msg"
    }
    proc MyTestAlias {interp args} {
	MyError "some secret"
    }

Changes to tests/pkgMkIndex.test. 

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.8 1999/04/01 23:22:32 welch Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
................................................................................
source [file join pkg pkg2_b.tcl]}} {pkg5:1.0 {source [file join pkg pkg5.tcl]}}}"

test pkgMkIndex-9.1 {circular packages} {
    pkgtest::runIndex pkg circ1.tcl circ2.tcl circ3.tcl
} {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}}

# Some tests require the existence of one of the DLLs in the dltest directory
set x [file join $::tcltest::testsDir \
	../unix/dltest/pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
set ::tcltest::testConfig($dll) [file exists $x]

test pkgMkIndex-10.1 {package in DLL and script} $dll {
    file copy -force $x pkg
    pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"







|







 







|
|








4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341

#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.9 1999/04/07 02:38:11 hershey Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
................................................................................
source [file join pkg pkg2_b.tcl]}} {pkg5:1.0 {source [file join pkg pkg5.tcl]}}}"

test pkgMkIndex-9.1 {circular packages} {
    pkgtest::runIndex pkg circ1.tcl circ2.tcl circ3.tcl
} {0 {{circ1:1.0 {tclPkgSetup {circ1.tcl source {::circ1::c1-1 ::circ1::c1-2 ::circ1::c1-3 ::circ1::c1-4}}}} {circ2:1.0 {tclPkgSetup {circ2.tcl source {::circ2::c2-1 ::circ2::c2-2}}}} {circ3:1.0 {tclPkgSetup {circ3.tcl source ::circ3::c3-1}}}}}

# Some tests require the existence of one of the DLLs in the dltest directory
set x [file join [file dirname [info nameofexecutable]] dltest \
	pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
set ::tcltest::testConfig($dll) [file exists $x]

test pkgMkIndex-10.1 {package in DLL and script} $dll {
    file copy -force $x pkg
    pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"

This page was generated in about 0.02s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14