Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Fradin improvements in test suite too. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | core-8-5-branch |
Files: | files | file ages | folders |
SHA1: |
43a0a934b53928fcd888f6661dbf4d50 |
User & Date: | dgp 2013-01-30 16:51:36 |
Context
2013-01-30
| ||
17:15 | More improvements found browsing tcltest. check-in: 38058afdf7 user: dgp tags: core-8-5-branch | |
16:52 | Fradin improvements in test suite too check-in: 71b3eaddaa user: dgp tags: trunk | |
16:51 | Fradin improvements in test suite too. check-in: 43a0a934b5 user: dgp tags: core-8-5-branch | |
16:27 | For tcltest, selected modernizations and style improvements from Patrick Fradin. check-in: 1209ebb68f user: dgp tags: core-8-5-branch | |
Changes
Changes to tests/tcltest.test.
︙ | ︙ | |||
76 77 78 79 80 81 82 | i eval [list set argv [lrange $args 1 end]] i eval [list package ifneeded tcltest [package provide tcltest] \ [package ifneeded tcltest [package provide tcltest]]] i eval {proc exit args {}} # Need to capture output in msg | | < < < < < | 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 | i eval [list set argv [lrange $args 1 end]] i eval [list package ifneeded tcltest [package provide tcltest] \ [package ifneeded tcltest [package provide tcltest]]] i eval {proc exit args {}} # Need to capture output in msg set code [catch {i eval {source $argv0}}] i eval {close $tcltest::outputChannel} interp delete [namespace current]::i set f [open $of] set msg [read -nonewline $f] close $f set f [open $ef] set err [read -nonewline $f] close $f removeFile output removeFile error if {[string length $err]} { set code 1 append msg \n$err } return $code } test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} { set result [slave msg test.tcl] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+4.+Passed.+1.+Skipped.+1.+Failed.+2" $msg] } {0 1 0 0 1} |
︙ | ︙ | |||
545 546 547 548 549 550 551 | } # Test non-writeable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable switch -- $::tcl_platform(platform) { | | | 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 | } # Test non-writeable directories, non-readable directories with directory flags set notReadableDir [file join [temporaryDirectory] notreadable] set notWriteableDir [file join [temporaryDirectory] notwriteable] makeDirectory notreadable makeDirectory notwriteable switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 00333 file attributes $notWriteableDir -permissions 00555 } default { catch {file attributes $notWriteableDir -readonly 1} catch {testchmod 000 $notWriteableDir} } |
︙ | ︙ | |||
712 713 714 715 716 717 718 | set ::tcltest::workingDirectory $old cd $current } } # clean up from directory testing | | | | | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 | set ::tcltest::workingDirectory $old cd $current } } # clean up from directory testing switch -- $::tcl_platform(platform) { unix { file attributes $notReadableDir -permissions 777 file attributes $notWriteableDir -permissions 777 } default { catch {testchmod 777 $notWriteableDir} catch {file attributes $notWriteableDir -readonly 0} } } file delete -force -- $notReadableDir $notWriteableDir removeFile a.tcl removeFile thisdirectoryisafile removeDirectory normaldirectory # -file, -notfile, [matchFiles], [skipFiles] test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup { set old [testsDirectory] |
︙ | ︙ | |||
1146 1147 1148 1149 1150 1151 1152 | slave1 eval [list set argv {-debug 2}] slave1 alias puts puts interp create slave2 slave2 alias puts puts } -cleanup { interp delete slave2 interp delete slave1 | | | 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 | slave1 eval [list set argv {-debug 2}] slave1 alias puts puts interp create slave2 slave2 alias puts puts } -cleanup { interp delete slave2 interp delete slave1 if {$oldoptions eq "none"} { unset ::env(TCLTEST_OPTIONS) } else { set ::env(TCLTEST_OPTIONS) $oldoptions } } -body { slave1 eval [package ifneeded tcltest [package provide tcltest]] slave1 eval tcltest::debug |
︙ | ︙ |