Tcl Source Code

Check-in [51ffe4e6ae]
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:Added tests for auto_mkindex_parser quoting problems, BUGID 1657
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 51ffe4e6aeb1ac478aa5b29f26e8d94183d4199a
User & Date: welch 1999-03-31 18:58:50
Context
1999-03-31
22:37
Fixed pkg_mkIndex when input files do "namespace import". BUG 1327 check-in: dcd8e76bfe user: welch tags: trunk
18:58
Added tests for auto_mkindex_parser quoting problems, BUGID 1657 check-in: 51ffe4e6ae user: welch tags: trunk
18:58
Fixed quoting bugs in auto_mkindex_parser, BUGID 1657 check-in: 0899c7c6c0 user: welch tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/autoMkindex.tcl. 

46
47
48
49
50
51
52






















    }
    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}




























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

46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

    }
    namespace eval ::buried {
        proc relative {args} {return "relative: $args"}
        proc ::top {args} {return "top: $args"}
        proc ::buried::explicit {args} {return "explicit: $args"}
    }
}

# With proper hooks, we should be able to support other commands
# that create procedures

proc buried::myproc {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd1 args {return "mycmd"}
    myproc mycmd2 args {return "mycmd"}
}
::buried::myproc mycmd3 args {return "another"}

proc {buried::my proc} {name body args} {
    ::proc $name $body $args
}
namespace eval ::buried {
    proc mycmd4 args {return "mycmd"}
    {my proc} mycmd5 args {return "mycmd"}
}
{::buried::my proc} mycmd6 args {return "another"}

Changes to tests/autoMkindex.test. 

4
5
6
7
8
9
10
11
12
13



14
15
16
17
18
19
20
..
25
26
27
28
29
30
31
32
33
34
35
36
37

38

39
40
41
42
43
44
45
46
47
..
49
50
51
52
53
54
55
56

57



















































































58
59
60



61

# the autoloading index.
#
# Copyright (c) 1998  Lucent Technologies, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: autoMkindex.test,v 1.3 1998/10/06 19:12:06 rjohnson Exp $

if {[string compare test [info procs test]] == 1} then {source defs}




test autoMkindex-1.1 {remove any existing tclIndex file} {
    file delete tclIndex
    file exists tclIndex
} {0}

test autoMkindex-1.2 {build tclIndex based on a test file} {
................................................................................
set element "{source [file join . autoMkindex.tcl]}"

test autoMkindex-1.3 {examine tclIndex} {
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set result ""
        foreach elem [lsort [array names auto_index]] {
            lappend result [list $elem $auto_index($elem)]
        }
        set result
    }

} "{::buried::explicit $element} {::buried::inside $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"


namespace delete tcl_autoMkindex_tmp

test autoMkindex-2.1 {commands on the autoload path can be imported} {
    set interp [interp create]
    set final [$interp eval {
        namespace eval blt {}
        set auto_path [linsert $auto_path 0 .]
        set info [list [catch {namespace import buried::*} result] $result]
................................................................................
            lappend info $name [namespace origin $name]
        }
        set info
    }]
    interp delete $interp
    set final
} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"


#



















































































# Clean up.
#




catch {file delete tclIndex}







|


>
>
>







 







|

|

<

>
|
>

<







 








>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>
>
>


4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
28
29
30
31
32
33
34
35
36
37
38

39
40
41
42
43

44
45
46
47
48
49
50
..
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

# the autoloading index.
#
# Copyright (c) 1998  Lucent Technologies, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: autoMkindex.test,v 1.4 1999/03/31 18:58:50 welch Exp $

if {[string compare test [info procs test]] == 1} then {source defs}

set saveCommands $auto_mkindex_parser::initCommands
set result ""

test autoMkindex-1.1 {remove any existing tclIndex file} {
    file delete tclIndex
    file exists tclIndex
} {0}

test autoMkindex-1.2 {build tclIndex based on a test file} {
................................................................................
set element "{source [file join . autoMkindex.tcl]}"

test autoMkindex-1.3 {examine tclIndex} {
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }

    }
    namespace delete tcl_autoMkindex_tmp
    set ::result
} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"



test autoMkindex-2.1 {commands on the autoload path can be imported} {
    set interp [interp create]
    set final [$interp eval {
        namespace eval blt {}
        set auto_path [linsert $auto_path 0 .]
        set info [list [catch {namespace import buried::*} result] $result]
................................................................................
            lappend info $name [namespace origin $name]
        }
        set info
    }]
    interp delete $interp
    set final
} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"

# Test auto_mkindex hooks

# Slave hook executes interesting code in the interp used to watch code.

test autoMkindex-3.1 {slaveHook} {
    auto_mkindex_parser::slavehook {
	_%@namespace eval ::blt {
	    proc foo {} {}
	    _%@namespace export foo
	}
    }
    auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
    auto_mkindex . autoMkindex.tcl
     
    # Reset initCommands to avoid trashing other tests

    set auto_mkindex_parser::initCommands $saveCommands
    file exists tclIndex
} 1 

# The auto_mkindex_parser::command is used to register commands
# that create new commands.

test autoMkindex-3.2 {auto_mkindex_parser::command} {
    auto_mkindex_parser::command buried::myproc {name args} {
	variable index
	variable scriptFile
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
    }
    namespace delete tcl_autoMkindex_tmp

    # Reset initCommands to avoid trashing other tests

    set auto_mkindex_parser::initCommands $saveCommands
    set ::result
} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"


test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
    auto_mkindex_parser::command {buried::my proc} {name args} {
	variable index
	variable scriptFile
	puts "my proc $name"
	append index [list set auto_index([fullname $name])] \
		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
    }
    auto_mkindex . autoMkindex.tcl
    namespace eval tcl_autoMkindex_tmp {
        set dir "."
        variable auto_index
        source tclIndex
        set ::result ""
        foreach elem [lsort [array names auto_index]] {
            lappend ::result [list $elem $auto_index($elem)]
        }
    }
    namespace delete tcl_autoMkindex_tmp

    # Reset initCommands to avoid trashing other tests

    set auto_mkindex_parser::initCommands $saveCommands
    proc lvalue {list pattern} {
	set ix [lsearch $list $pattern]
	if {$ix >= 0} {
	    return [lindex $list $ix]
	} else {
	    return {}
	}
    }
    list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"


#
# Clean up.
#

set auto_mkindex_parser::initCommands $saveCommands
unset result
unset saveCommands
catch {file delete tclIndex}

Added tests/platform.test. 










































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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

# The file tests the tcl_platform variable
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 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: @(#) 

if {[info procs test] != "test"} {source defs}

test platform-1.1 {TclpSetVariables: tcl_platform} {
    lsort [array names tcl_platform]
} {byteOrder machine os osVersion platform}

return

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