diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/encoding.test | 6 | ||||
| -rw-r--r-- | tests/interp.test | 4 | ||||
| -rw-r--r-- | tests/macFCmd.test | 10 | ||||
| -rw-r--r-- | tests/parseOld.test | 7 | ||||
| -rw-r--r-- | tests/regexp.test | 12 | ||||
| -rwxr-xr-x | tests/tcltest.test | 125 |
6 files changed, 107 insertions, 57 deletions
diff --git a/tests/encoding.test b/tests/encoding.test index 9d79603..6ee06ff 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: encoding.test,v 1.5 1999/07/02 06:41:29 welch Exp $ +# RCS: @(#) $Id: encoding.test,v 1.6 1999/08/23 17:54:59 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -62,7 +62,7 @@ test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} { set system [encoding system] set path [testencoding path] encoding system jis0208 ;# incr ref count - testencoding path . + testencoding path [list [pwd]] set x [encoding convertto jis0208 \u4e4e] ;# old one found encoding system identity lappend x [catch {encoding convertto jis0208 \u4e4e} msg] $msg @@ -99,7 +99,7 @@ test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} { foreach encoding [encoding names] { set encodings($encoding) 1 } - testencoding path . + testencoding path [list [pwd]] foreach encoding [encoding names] { if {![info exists encodings($encoding)]} { lappend x $encoding diff --git a/tests/interp.test b/tests/interp.test index ed37f6b..91dfcb5 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # 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.9 1999/06/26 20:55:08 rjohnson Exp $ +# RCS: @(#) $Id: interp.test,v 1.10 1999/08/23 17:54:59 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -1701,7 +1701,7 @@ test interp-23.3 {testing hiding vs aliases} {macOnly} { lappend l [lsort [interp hidden a]] interp delete a set l -} {{beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo exit fconfigure file glob load ls open pwd socket source}} +} {{beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo encoding exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo encoding exit fconfigure file glob load ls open pwd socket source}} test interp-24.1 {result resetting on error} { catch {interp delete a} diff --git a/tests/macFCmd.test b/tests/macFCmd.test index 27604cc..0ad77fe 100644 --- a/tests/macFCmd.test +++ b/tests/macFCmd.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: macFCmd.test,v 1.5 1999/07/01 17:36:18 jenn Exp $ +# RCS: @(#) $Id: macFCmd.test,v 1.6 1999/08/23 17:54:59 jenn Exp $ # if {[lsearch [namespace children] ::tcltest] == -1} { @@ -32,7 +32,7 @@ file delete -force foo.dir test macFCmd-1.1 {GetFileFinderAttributes - no file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -creator} msg] $msg -} {1 {couldn't get attributes for file ":foo.file": no such file or directory}} +} {1 {could not read ":foo.file": no such file or directory}} test macFCmd-1.2 {GetFileFinderAttributes - creator} {macOnly} { catch {file delete -force foo.file} catch {close [open foo.file w]} @@ -80,7 +80,7 @@ test macFCmd-1.8 {GetFileFinderAttributes - folder hidden} {macOnly} { test macFCmd-2.1 {GetFileReadOnly - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -readonly} msg] $msg -} {1 {couldn't get attributes for file ":foo.file": no such file or directory}} +} {1 {could not read ":foo.file": no such file or directory}} test macFCmd-2.2 {GetFileReadOnly - file not read only} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] @@ -111,7 +111,7 @@ test macFCmd-2.5 {GetFileReadOnly - directory read only} {macOnly fileSharing} { test macFCmd-3.1 {SetFileFinderAttributes - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -creator FOOO} msg] $msg -} {1 {couldn't set attributes for file ":foo.file": no such file or directory}} +} {1 {could not read ":foo.file": no such file or directory}} test macFCmd-3.2 {SetFileFinderAttributes - creator} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] @@ -152,7 +152,7 @@ test macFCmd-3.7 {SetFileFinderAttributes - directory} {macOnly} { test macFCmd-4.1 {SetFileReadOnly - bad file} {macOnly} { catch {file delete -force foo.file} list [catch {file attributes foo.file -readonly 1} msg] $msg -} {1 {couldn't set attributes for file ":foo.file": no such file or directory}} +} {1 {could not read ":foo.file": no such file or directory}} test macFCmd-4.2 {SetFileReadOnly - file not readonly} {macOnly} { catch {file delete -force foo.file} close [open foo.file w] diff --git a/tests/parseOld.test b/tests/parseOld.test index fc450b3..a692bbb 100644 --- a/tests/parseOld.test +++ b/tests/parseOld.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseOld.test,v 1.6 1999/07/06 23:55:44 jenn Exp $ +# RCS: @(#) $Id: parseOld.test,v 1.7 1999/08/23 17:54:59 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -340,6 +340,11 @@ test parseOld-10.13 {syntax errors} { {b}] set a } {a b} + +# The next test will fail on the Mac, 'cause the MSL uses a fixed sized +# buffer for %d conversions (LAME!). I won't leave the test out, however, +# since MetroWerks may some day fix this. + test parseOld-10.14 {syntax errors} { list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo } {1 {missing )} {missing ) diff --git a/tests/regexp.test b/tests/regexp.test index d17f2be..b0f101c 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: regexp.test,v 1.8 1999/06/26 20:55:10 rjohnson Exp $ +# RCS: @(#) $Id: regexp.test,v 1.9 1999/08/23 17:54:59 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -363,7 +363,10 @@ test regexp-11.7 {regsub errors} { list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg } {1 {couldn't set variable "f1(f2)"}} -test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} { +# This test crashes on the Mac unless you increase the Stack Space to about 1 +# Meg. This is probably bigger than most users want... + +test regexp-12.1 {macCrash} {Tcl_RegExpExec: large number of subexpressions} { list [regexp (.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) abcdefghijklmnopqrstuvwxyz all a b c d e f g h i j k l m n o p q r s t u v w x y z] $all $a $b $c $d $e $f $g $h $i $j $k $l $m $n $o $p $q $r $s $t $u $v $w $x $y $z } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z} @@ -403,7 +406,10 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} { append x *a regexp -nocase $x bbba } 1 -test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} { + +# There is no exec on the Mac ... + +test regexp-14.3 {unixOrPc} {CompileRegexp: regexp cache, empty regexp and empty cache} { makeFile {puts [regexp {} foo]} junk.tcl exec $::tcltest::tcltest junk.tcl } 1 diff --git a/tests/tcltest.test b/tests/tcltest.test index f1f709d..855e433 100755 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -1,6 +1,6 @@ # Command line options covered: -# -help, -verbose, -match, -skip, -file, -notfile, -relateddir, -asidefromdir -# -constraints, -limitconstraints, -preservecore, -tmpdir, -debug, -outfile, +# -help, -verbose, -match, -skip, -file, -notfile, -constraints, +# -limitconstraints, -preservecore, -tmpdir, -debug, -outfile, # -errfile # # This file contains a collection of tests for one or more of the Tcl @@ -10,7 +10,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: tcltest.test,v 1.5 1999/08/10 05:09:20 hobbs Exp $ +# RCS: @(#) $Id: tcltest.test,v 1.6 1999/08/23 17:54:59 jenn Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -33,51 +33,52 @@ makeFile { } test.tcl # test -help -test tcltest-1.1 {tcltest -help} { +test tcltest-1.1 {tcltest -help} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -help} msg] + set result [catch {runCmd $cmd}] list $result [regexp Usage $msg] } {1 1} -test tcltest-1.2 {tcltest -help -something} { +test tcltest-1.2 {tcltest -help -something} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -help -something} msg] list $result [regexp Usage $msg] } {1 1} -test tcltest-1.3 {tcltest -h} { +test tcltest-1.3 {tcltest -h} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -h} msg] list $result [regexp Usage $msg] } {1 1} # -verbose -test tcltest-2.0 {tcltest (verbose default - 'b')} { +test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 1 0 0 1} -test tcltest-2.1 {tcltest -v 'b'} { +test tcltest-2.1 {tcltest -v 'b'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -v 'b'} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 1 0 0 1} -test tcltest-2.2 {tcltest -v 'p'} { +test tcltest-2.2 {tcltest -v 'p'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -v 'p'} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 0 1 0 1} -test tcltest-2.3 {tcltest -v 's'} { +test tcltest-2.3 {tcltest -v 's'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -v 's'} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 0 0 1 1} -test tcltest-2.4 {tcltest -v 'ps'} { +test tcltest-2.4 {tcltest -v 'ps'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -verbose 'ps'} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 0 1 1 1} -test tcltest-2.5 {tcltest -v 'psb'} { +test tcltest-2.5 {tcltest -v 'psb'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -v 'psb'} msg] list $result [regexp "Contents of test case" $msg] [regexp a-1.0 $msg] \ [regexp c-1.0 $msg] \ @@ -85,61 +86,61 @@ test tcltest-2.5 {tcltest -v 'psb'} { } {0 1 1 1 1} # -match -test tcltest-3.1 {tcltest -match 'a*'} { +test tcltest-3.1 {tcltest -match 'a*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -match a* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg] } {0 1 0 0 1} -test tcltest-3.2 {tcltest -match 'b*'} { +test tcltest-3.2 {tcltest -match 'b*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -m b* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 0 1} -test tcltest-3.3 {tcltest -match 'c*'} { +test tcltest-3.3 {tcltest -match 'c*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -match c* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg] } {0 0 0 1 1} -test tcltest-3.4 {tcltest -match 'a* b*'} { +test tcltest-3.4 {tcltest -match 'a* b*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 1 1 0 1} # -skip -test tcltest-4.1 {tcltest -skip 'a*'} { +test tcltest-4.1 {tcltest -skip 'a*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -skip a* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+0.+Skipped.+2.+Failed.+1" $msg] } {0 0 1 1 1} -test tcltest-4.2 {tcltest -skip 'b*'} { +test tcltest-4.2 {tcltest -skip 'b*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -s b* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg] } {0 1 0 1 1} -test tcltest-4.3 {tcltest -skip 'c*'} { +test tcltest-4.3 {tcltest -skip 'c*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -skip c* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+1.+Failed.+1" $msg] } {0 1 1 0 1} -test tcltest-4.4 {tcltest -skip 'a* b*'} { +test tcltest-4.4 {tcltest -skip 'a* b*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -skip {a* b*} -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+0.+Skipped.+3.+Failed.+0" $msg] } {0 0 0 1 1} -test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} { +test tcltest-4.5 {tcltest -match 'a* b*' -skip 'b*'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -match {a* b*} -skip b* -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg] } {0 1 0 0 1} # -constraints, -limitconstraints -test tcltest-5.1 {tcltest -constraints 'knownBug'} { +test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'ps'} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+2.+Skipped.+0.+Failed.+1" $msg] } {0 1 1 1 1} -test tcltest-5.1 {tcltest -constraints 'knownBug'} { +test tcltest-5.1 {tcltest -constraints 'knownBug'} {unixOrPc} { set result [catch {exec $::tcltest::tcltest test.tcl -constraints knownBug -v 'p' -limitconstraints 1} msg] list $result [regexp a-1.0 $msg] [regexp b-1.0 $msg] [regexp c-1.0 $msg] \ [regexp "Total.+3.+Passed.+1.+Skipped.+2.+Failed.+0" $msg] @@ -160,25 +161,25 @@ makeFile { } printerror.tcl # -outfile, -errfile -test tcltest-6.1 {tcltest -outfile, -errfile defaults} { +test tcltest-6.1 {tcltest -outfile, -errfile defaults} {unixOrPc} { catch {exec $::tcltest::tcltest printerror.tcl} msg list [regexp "a test" $msg] [regexp "a really" $msg] } {1 1} -test tcltest-6.2 {tcltest -outfile a.tmp} { +test tcltest-6.2 {tcltest -outfile a.tmp} {unixOrPc} { catch {exec $::tcltest::tcltest printerror.tcl -outfile a.tmp} msg set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {0 1 0 1 1 {}} -test tcltest-6.3 {tcltest -errfile a.tmp} { +test tcltest-6.3 {tcltest -errfile a.tmp} {unixOrPc} { catch {exec $::tcltest::tcltest printerror.tcl -errfile a.tmp} msg set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" a.tmp}] list [regexp "a test" $msg] [regexp "a really" $msg] \ $result1 $result2 [file exists a.tmp] [file delete a.tmp] } {1 0 1 0 1 {}} -test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} { +test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} {unixOrPc} { catch {exec $::tcltest::tcltest printerror.tcl -o a.tmp -e b.tmp} msg set result1 [catch {exec grep "a test" a.tmp}] set result2 [catch {exec grep "a really" b.tmp}] @@ -189,25 +190,25 @@ test tcltest-6.4 {tcltest -outfile a.tmp -errfile b.tmp} { } {0 0 0 0 1 {} 1 {}} # -debug -test tcltest-7.1 {tcltest test.tcl -d 0} { +test tcltest-7.1 {tcltest test.tcl -d 0} {unixOrPc} { catch {exec $::tcltest::tcltest test.tcl -d 0} msg regexp "Flags passed into tcltest" $msg } {0} -test tcltest-7.2 {tcltest test.tcl -d 1} { +test tcltest-7.2 {tcltest test.tcl -d 1} {unixOrPc} { catch {exec $::tcltest::tcltest test.tcl -d 1 -s b*} msg list [regexp userSpecifiedSkip $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.3 {tcltest test.tcl -d 1} { +test tcltest-7.3 {tcltest test.tcl -d 1} {unixOrPc} { catch {exec $::tcltest::tcltest test.tcl -d 1 -m b*} msg list [regexp userSpecifiedNonMatch $msg] \ [regexp "Flags passed into tcltest" $msg] } {1 0} -test tcltest-7.4 {tcltest test.tcl -d 2} { +test tcltest-7.4 {tcltest test.tcl -d 2} {unixOrPc} { catch {exec $::tcltest::tcltest test.tcl -d 2} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 0} -test tcltest-7.5 {tcltest test.tcl -d 3} { +test tcltest-7.5 {tcltest test.tcl -d 3} {unixOrPc} { catch {exec $::tcltest::tcltest test.tcl -d 3} msg list [regexp "Flags passed into tcltest" $msg] [regexp "Running" $msg] } {1 1} @@ -222,28 +223,66 @@ makeFile { makeFile {} thisdirectoryisafile # -tmpdir -test tcltest-8.1 {tcltest a.tcl -tmpdir a} { +test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} { file delete -force thisdirectorydoesnotexist exec $::tcltest::tcltest a.tcl -tmpdir thisdirectorydoesnotexist list [file exists [file join thisdirectorydoesnotexist a.tmp]] \ [file delete -force thisdirectorydoesnotexist] } {1 {}} -test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} { +test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {unixOrPc} { catch {exec $::tcltest::tcltest a.tcl -tmpdir thisdirectoryisafile} msg # The join is necessary because the message can be split on multiple lines list [regexp "not a directory" [join $msg]] } {1} -# Platform-specific attribute testing still needs to be set up -# (non-writeable directories, non-readable directories) as tmpdir -- jlh +# Test non-writeable directories, non-readable directories with tmpdir +set notReadableDir [file join $::tcltest::temporaryDirectory notreadable] +set notWriteableDir [file join $::tcltest::temporaryDirectory notwriteable] + +::tcltest::makeDirectory notreadable +::tcltest::makeDirectory notwriteable + +switch $tcl_platform(platform) { + "unix" { + file attributes $notReadableDir -permissions 00333 + file attributes $notWriteableDir -permissions 00555 + } + default { + file attributes $notWriteableDir -readonly 1 + } +} + +test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unixOnly} { + catch {exec $::tcltest::tcltest a.tcl -tmpdir $notReadableDir} msg + # The join is necessary because the message can be split on multiple lines + list [regexp {not readable} [join $msg]] +} {1} + +test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc} { + catch {exec $::tcltest::tcltest a.tcl -tmpdir $notWriteableDir} msg + # The join is necessary because the message can be split on multiple lines + list [regexp {not writeable} [join $msg]] +} {1} + +switch $tcl_platform(platform) { + "unix" { + file attributes $notReadableDir -permissions 777 + file attributes $notWriteableDir -permissions 777 + } + default { + file attributes $notWriteableDir -readonly 0 + } +} + +file delete -force $notReadableDir $notWriteableDir # -file -notfile -test tcltest-9.1 {-file a*.tcl} { +test tcltest-9.1 {-file a*.tcl} {unixOrPc} { catch {exec $::tcltest::tcltest \ [file join $::tcltest::testsDirectory all.tcl] -file a*.test} msg list [regexp assocd\.test $msg] } {1} -test tcltest-9.2 {-file a*.tcl} { +test tcltest-9.2 {-file a*.tcl} {unixOrPc} { catch {exec $::tcltest::tcltest \ [file join $::tcltest::testsDirectory all.tcl] \ -file a*.test -notfile assocd*} msg @@ -261,23 +300,23 @@ makeFile { return } makecore.tcl # -preservecore -test tcltest-10.1 {-preservecore 0} { +test tcltest-10.1 {-preservecore 0} {unixOrPc} { catch {exec $::tcltest::tcltest makecore.tcl -preservecore 0} msg file delete core regexp "produced core file" $msg } {0} -test tcltest-10.2 {-preservecore 1} { +test tcltest-10.2 {-preservecore 1} {unixOrPc} { catch {exec $::tcltest::tcltest makecore.tcl -preservecore 1} msg file delete core regexp "produced core file" $msg } {1} -test tcltest-10.3 {-preservecore 2} { +test tcltest-10.3 {-preservecore 2} {unixOrPc} { catch {exec $::tcltest::tcltest makecore.tcl -preservecore 2} msg file delete core list [regexp "==== makecore produced core file" $msg] [regexp "Moving file to" $msg] \ [regexp "core-" $msg] [file delete core-makecore] } {1 1 1 {}} -test tcltest-10.4 {-preservecore 3} { +test tcltest-10.4 {-preservecore 3} {unixOrPc} { catch {exec $::tcltest::tcltest makecore.tcl -preservecore 3} msg file delete core list [regexp "produced core file" $msg] [regexp "Moving file to" $msg] \ @@ -287,7 +326,7 @@ test tcltest-10.4 {-preservecore 3} { # Begin testing of tcltest procs ... # PrintError -test tcltest-11.1 {PrintError} { +test tcltest-11.1 {PrintError} {unixOrPc} { set result [catch {exec $::tcltest::tcltest printerror.tcl} msg] list $result [regexp "Error: a really short string" $msg] \ [regexp " \"quotes\"" $msg] [regexp " \"Path" $msg] \ |