Differences From Artifact [e26dbfaf7a]:
- File tests/info.test — part of check-in [c547f7334a] at 1998-11-11 02:39:56 on branch trunk — Fixed quoting of { in an info complete test case. (user: welch size: 17632)
To Artifact [44873c091b]:
- File tests/info.test — part of check-in [f3b32fb71c] at 1999-04-16 00:46:29 on branch trunk — merged tcl 8.1 branch back into the main trunk (user: stanton size: 15606)
1 2 3 4 5 6 7 | # Commands covered: info # # 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) 1991-1994 The Regents of the University of California. | | > | > > > | > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
# Commands covered: info
#
# 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) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-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: info.test,v 1.6 1999/04/16 00:47:29 stanton Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
}
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
catch {namespace delete test_ns_info1 test_ns_info2}
namespace eval test_ns_info1 {
namespace export *
proc p {x} {return "x=$x"}
proc q {{y 27} z} {return "y=$y"}
}
test info-1.1 {info args option} {
proc t1 {a bbb c} {return foo}
info args t1
} {a bbb c}
test info-1.2 {info args option} {
proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
|
| ︙ | ︙ | |||
34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 |
list [catch {info args set} msg] $msg
} {1 {"set" isn't a procedure}}
test info-1.6 {info args option} {
proc t1 {a b} {set c 123; set d $c}
t1 1 2
info args t1
} {a b}
test info-2.1 {info body option} {
proc t1 {} {body of t1}
info body t1
} {body of t1}
test info-2.2 {info body option} {
list [catch {info body set} msg] $msg
} {1 {"set" isn't a procedure}}
test info-2.3 {info body option} {
list [catch {info args set 1} msg] $msg
} {1 {wrong # args: should be "info args procname"}}
# "info cmdcount" is no longer accurate for compiled commands! The expected
# result for info-3.1 used to be "3" and is now "1" since the "set"s have
# been compiled away.
test info-3.1 {info cmdcount option} {
set x [info cmdcount]
set y 12345
set z [info cm]
expr $z-$x
} 1
| > > > > > > > > > > > > > > | | 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 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 |
list [catch {info args set} msg] $msg
} {1 {"set" isn't a procedure}}
test info-1.6 {info args option} {
proc t1 {a b} {set c 123; set d $c}
t1 1 2
info args t1
} {a b}
test info-1.7 {info args option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
list [info args p] [info args q]
}
} {x {y z}}
test info-2.1 {info body option} {
proc t1 {} {body of t1}
info body t1
} {body of t1}
test info-2.2 {info body option} {
list [catch {info body set} msg] $msg
} {1 {"set" isn't a procedure}}
test info-2.3 {info body option} {
list [catch {info args set 1} msg] $msg
} {1 {wrong # args: should be "info args procname"}}
test info-2.4 {info body option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
list [info body p] [info body q]
}
} {{return "x=$x"} {return "y=$y"}}
# "info cmdcount" is no longer accurate for compiled commands! The expected
# result for info-3.1 used to be "3" and is now "1" since the "set"s have
# been compiled away.
test info-3.1 {info cmdcount option} {
set x [info cmdcount]
set y 12345
set z [info cm]
expr $z-$x
} 1
test info-3.2 {info cmdcount option} {
list [catch {info cmdcount 1} msg] $msg
} {1 {wrong # args: should be "info cmdcount"}}
test info-4.1 {info commands option} {
proc t1 {} {}
proc t2 {} {}
set x " [info commands] "
|
| ︙ | ︙ | |||
89 90 91 92 93 94 95 |
catch {rename _t1_ {}}
catch {rename _t2_ {}}
test info-4.5 {info commands option} {
list [catch {info commands a b} msg] $msg
} {1 {wrong # args: should be "info commands ?pattern?"}}
test info-5.1 {info complete option} {
| > > > | | | < < < < < < < < < < < < < < < < < < < < < | < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 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 |
catch {rename _t1_ {}}
catch {rename _t2_ {}}
test info-4.5 {info commands option} {
list [catch {info commands a b} msg] $msg
} {1 {wrong # args: should be "info commands ?pattern?"}}
test info-5.1 {info complete option} {
list [catch {info complete} msg] $msg
} {1 {wrong # args: should be "info complete command"}}
test info-5.2 {info complete option} {
info complete abc
} 1
test info-5.2 {info complete option} {
info complete "\{abcd "
} 0
test info-5.3 {info complete option} {
info complete {# Comment should be complete command}
} 1
test info-6.1 {info default option} {
proc t1 {a b {c d} {e "long default value"}} {}
info default t1 a value
} 0
test info-6.2 {info default option} {
proc t1 {a b {c d} {e "long default value"}} {}
|
| ︙ | ︙ | |||
284 285 286 287 288 289 290 291 292 293 294 295 296 297 |
} {1 {couldn't store default value in variable "a"}}
test info-6.10 {info default option} {
catch {unset a}
set a(0) 88
proc t1 {{a 18} b} {}
list [catch {info default t1 a a} msg] $msg
} {1 {couldn't store default value in variable "a"}}
catch {unset a}
test info-7.1 {info exists option} {
set value foo
info exists value
} 1
catch {unset _nonexistent_}
| > > > > > > > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 |
} {1 {couldn't store default value in variable "a"}}
test info-6.10 {info default option} {
catch {unset a}
set a(0) 88
proc t1 {{a 18} b} {}
list [catch {info default t1 a a} msg] $msg
} {1 {couldn't store default value in variable "a"}}
test info-6.11 {info default option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
list [info default p x foo] $foo [info default q y bar] $bar
}
} {0 {} 1 27}
catch {unset a}
test info-7.1 {info exists option} {
set value foo
info exists value
} 1
catch {unset _nonexistent_}
|
| ︙ | ︙ | |||
412 413 414 415 416 417 418 |
set tcl_library $savedLibrary
test info-11.1 {info loaded option} {
list [catch {info loaded a b} msg] $msg
} {1 {wrong # args: should be "info loaded ?interp?"}}
test info-11.2 {info loaded option} {
list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
| | | 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 |
set tcl_library $savedLibrary
test info-11.1 {info loaded option} {
list [catch {info loaded a b} msg] $msg
} {1 {wrong # args: should be "info loaded ?interp?"}}
test info-11.2 {info loaded option} {
list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
} {0 1 {could not find interpreter "gorp"}}
test info-12.1 {info locals option} {
set a 22
proc t1 {x y} {
set b 13
set c testing
global a
|
| ︙ | ︙ | |||
495 496 497 498 499 500 501 |
lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-15.3 {info procs option} {
list [catch {info procs 2 3} msg] $msg
} {1 {wrong # args: should be "info procs ?pattern?"}}
| | > | > | | | > | | | | | 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 |
lsort [info pr _tt*]
} {_tt1 _tt2}
catch {rename _tt1 {}}
catch {rename _tt2 {}}
test info-15.3 {info procs option} {
list [catch {info procs 2 3} msg] $msg
} {1 {wrong # args: should be "info procs ?pattern?"}}
test info-15.4 {info procs option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
proc r {} {}
list [info procs] [info procs p*]
}
} {{p q r} p}
test info-16.1 {info script option} {
list [catch {info script x} msg] $msg
} {1 {wrong # args: should be "info script"}}
test info-16.2 {info script option} {
file tail [info sc]
} "info.test"
removeFile gorp.info
makeFile "info script\n" gorp.info
test info-16.3 {info script option} {
list [source gorp.info] [file tail [info script]]
} [list gorp.info info.test]
test info-16.4 {resetting "info script" after errors} {
catch {source ~_nobody_/foo}
file tail [info script]
} "info.test"
test info-16.5 {resetting "info script" after errors} {
catch {source _nonexistent_}
file tail [info script]
} "info.test"
removeFile gorp.info
test info-17.1 {info sharedlibextension option} {
list [catch {info sharedlibextension foo} msg] $msg
} {1 {wrong # args: should be "info sharedlibextension"}}
test info-18.1 {info tclversion option} {
|
| ︙ | ︙ | |||
590 591 592 593 594 595 596 |
} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-20.4 {miscellaneous error conditions} {
list [catch {info l} msg] $msg
} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-20.5 {miscellaneous error conditions} {
list [catch {info s} msg] $msg
} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
| > > > > > > > > > > > > > > > > > | 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 |
} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-20.4 {miscellaneous error conditions} {
list [catch {info l} msg] $msg
} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
test info-20.5 {miscellaneous error conditions} {
list [catch {info s} msg] $msg
} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
# cleanup
catch {namespace delete test_ns_info1 test_ns_info2}
::tcltest::cleanupTests
return
|