Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | - added code to print the name of each test file that created files and did not clean them up (the list of files create follows the test file name). |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | core-8-1-branch-old |
| Files: | files | file ages | folders |
| SHA1: |
406483ed8357165d7c52f69894be4175 |
| User & Date: | hershey 1999-03-24 23:53:44 |
Context
|
1999-03-25
| ||
| 00:31 | Removed mention of Win32s. check-in: 248bb1b1f2 user: rjohnson tags: core-8-1-branch-old | |
|
1999-03-24
| ||
| 23:53 | - added code to print the name of each test file that created files and did not clean them up (the... check-in: 406483ed83 user: hershey tags: core-8-1-branch-old | |
| 23:53 | Make windows sockets implementation thread-safe by making the window used to handle socket events th... check-in: 74e05afb99 user: redman tags: core-8-1-branch-old | |
Changes
Changes to tests/defs.tcl.
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 .. 70 71 72 73 74 75 76 77 78 79 80 81 82 83 ... 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 ... 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 ... 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 ... 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 |
# of Sun Microsystems. # # Copyright (c) 1990-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: defs.tcl,v 1.1.2.5 1999/03/24 19:26:02 hershey Exp $ # Initialize wish shell if {[info exists tk_version]} { tk appname tktest wm title . tktest } else { # Ensure that we have a minimal auto_path so we don't pick up extra junk. ................................................................................ # check the current working dir for files created by the tests. # ::tcltest::filesMade keeps track of such files created using the # ::tcltest::makeFile and ::tcltest::makeDirectory procedures. # ::tcltest::filesExisted stores the names of pre-existing files. variable filesMade {} variable filesExisted {} # initialize ::tcltest::numTests array to keep track fo the number of # tests that pass, fial, and are skipped. array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] # initialize ::tcltest::skippedBecause array to keep track of # constraints that kept tests from running ................................................................................ if {[catch {array set flag $flagArray}]} { puts stderr "Error: odd number of command line args specified:" puts stderr " $argv" exit } # Allow for 1-char abbreviations, where applicable (e.g., -match == -m). # Note that -verbose cannot be abbreviated to -v in wish because it conflicts # with the wish option -visual. foreach arg {-verbose -match -skip -constraints} { set abbrev [string range $arg 0 1] if {([info exists flag($abbrev)]) && \ ([lsearch -exact $flagArray $arg] < \ [lsearch -exact $flagArray $abbrev])} { set flag($arg) $flag($abbrev) } ................................................................................ # since the tests were invoked. # # Print the number tests (total, passed, failed, and skipped) since the # tests were invoked. # proc ::tcltest::cleanupTests {{calledFromAllFile 0}} { # remove files and directories created by the tests foreach file $::tcltest::filesMade { if {[file exists $file]} { catch {file delete -force $file} puts "removed $file" } } set tail [file tail [info script]] if {$calledFromAllFile || $::tcltest::testSingleFile} { # print stats puts -nonewline stdout "$tail:" foreach index [list "Total" "Passed" "Skipped" "Failed"] { puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)" } puts stdout "" ................................................................................ foreach constraint [lsort [array names ::tcltest::skippedBecause]] { puts stdout \ "\t$::tcltest::skippedBecause($constraint)\t$constraint" unset ::tcltest::skippedBecause($constraint) } } # report the names of files in ::tcltest::workingDir that were not # pre-existing. set currentFiles {} foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { lappend currentFiles [file tail $file] } set filesNew {} foreach file $currentFiles { if {[lsearch -exact $::tcltest::filesExisted $file] == -1} { lappend filesNew $file puts "new: $file" } } if {[llength $filesNew] > 0} { puts stdout "Warning: created files:\t$filesNew" } # reset filesMade, filesExisted, and numTests set ::tcltest::filesMade {} set ::tcltest::filesExisted $currentFiles foreach index [list "Total" "Passed" "Skipped" "Failed"] { set ::tcltest::numTests($index) 0 } # exit only if running Tk in non-interactive mode global tk_version tcl_interactive if {[info exists tk_version] && !$tcl_interactive} { ................................................................................ # process running in the background. # Locate the tktest executable set ::tcltest::tktest [info nameofexecutable] if {$::tcltest::tktest == "{}"} { set ::tcltest::tktest {} puts stdout "Unable to find tktest executable, skipping multiple process tests." } # Create background process proc ::tcltest::setupbg args { if {$::tcltest::tktest == ""} { error "you're not running tktest so setupbg should not have been called" |
| > > > > | | > > | > > > > > | | | < | | > > > | < > > > > > > > > > > > > | | < > | | | < > | < < < < < < < < > | |
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 .. 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 ... 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 ... 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 438 439 440 441 ... 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 ... 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 |
# of Sun Microsystems. # # Copyright (c) 1990-1994 The Regents of the University of California. # Copyright (c) 1994-1996 Sun Microsystems, Inc. # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: defs.tcl,v 1.1.2.6 1999/03/24 23:53:44 hershey Exp $ # Initialize wish shell if {[info exists tk_version]} { tk appname tktest wm title . tktest } else { # Ensure that we have a minimal auto_path so we don't pick up extra junk. ................................................................................ # check the current working dir for files created by the tests. # ::tcltest::filesMade keeps track of such files created using the # ::tcltest::makeFile and ::tcltest::makeDirectory procedures. # ::tcltest::filesExisted stores the names of pre-existing files. variable filesMade {} variable filesExisted {} # ::tcltest::numTests will store test files as indices and the list # of files (that should not have been) left behind by the test files. array set ::tcltest::createdNewFiles {} # initialize ::tcltest::numTests array to keep track fo the number of # tests that pass, fial, and are skipped. array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0] # initialize ::tcltest::skippedBecause array to keep track of # constraints that kept tests from running ................................................................................ if {[catch {array set flag $flagArray}]} { puts stderr "Error: odd number of command line args specified:" puts stderr " $argv" exit } # Allow for 1-char abbreviations, where applicable (e.g., -match == -m). # Note that -verbose cannot be abbreviated to -v in wish because it # conflicts with the wish option -visual. foreach arg {-verbose -match -skip -constraints} { set abbrev [string range $arg 0 1] if {([info exists flag($abbrev)]) && \ ([lsearch -exact $flagArray $arg] < \ [lsearch -exact $flagArray $abbrev])} { set flag($arg) $flag($abbrev) } ................................................................................ # since the tests were invoked. # # Print the number tests (total, passed, failed, and skipped) since the # tests were invoked. # proc ::tcltest::cleanupTests {{calledFromAllFile 0}} { set tail [file tail [info script]] # Remove files and directories created by the :tcltest::makeFile and # ::tcltest::makeDirectory procedures. # Record the names of files in ::tcltest::workingDir that were not # pre-existing, and associate them with the test file that created them. if {!$calledFromAllFile} { foreach file $::tcltest::filesMade { if {[file exists $file]} { #catch {file delete -force $file} } } set currentFiles {} foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] { lappend currentFiles [file tail $file] } set newFiles {} foreach file $currentFiles { if {[lsearch -exact $::tcltest::filesExisted $file] == -1} { lappend newFiles $file } } set ::tcltest::filesExisted $currentFiles if {[llength $newFiles] > 0} { set ::tcltest::createdNewFiles($tail) $newFiles } } if {$calledFromAllFile || $::tcltest::testSingleFile} { # print stats puts -nonewline stdout "$tail:" foreach index [list "Total" "Passed" "Skipped" "Failed"] { puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)" } puts stdout "" ................................................................................ foreach constraint [lsort [array names ::tcltest::skippedBecause]] { puts stdout \ "\t$::tcltest::skippedBecause($constraint)\t$constraint" unset ::tcltest::skippedBecause($constraint) } } # report the names of test files in ::tcltest::createdNewFiles, and # reset the array to be empty. set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]] if {[llength $testFilesThatTurded] > 0} { puts stdout "Warning: test files left files behind:" foreach testFile $testFilesThatTurded { puts "\t$testFile:\t$::tcltest::createdNewFiles($testFile)" unset ::tcltest::createdNewFiles($testFile) } } # reset filesMade, filesExisted, and numTests set ::tcltest::filesMade {} foreach index [list "Total" "Passed" "Skipped" "Failed"] { set ::tcltest::numTests($index) 0 } # exit only if running Tk in non-interactive mode global tk_version tcl_interactive if {[info exists tk_version] && !$tcl_interactive} { ................................................................................ # process running in the background. # Locate the tktest executable set ::tcltest::tktest [info nameofexecutable] if {$::tcltest::tktest == "{}"} { set ::tcltest::tktest {} puts stdout \ "Unable to find tktest executable, skipping multiple process tests." } # Create background process proc ::tcltest::setupbg args { if {$::tcltest::tktest == ""} { error "you're not running tktest so setupbg should not have been called" |