diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-05-01 18:43:55 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-05-01 18:43:55 (GMT) |
commit | 48a249a15e53858f74eb76fc77a95ead5814eaf1 (patch) | |
tree | fa3efdc92ba4f7fa19f7905b5019e972359347a0 /tests | |
parent | 678622482afea72fdfcf94dcb285d1b0a68f6037 (diff) | |
parent | c326a211315ea119c01d51afeeb0378297100999 (diff) | |
download | tcl-48a249a15e53858f74eb76fc77a95ead5814eaf1.zip tcl-48a249a15e53858f74eb76fc77a95ead5814eaf1.tar.gz tcl-48a249a15e53858f74eb76fc77a95ead5814eaf1.tar.bz2 |
merge 8.7
Diffstat (limited to 'tests')
-rw-r--r-- | tests/fileName.test | 16 | ||||
-rw-r--r-- | tests/tcltest.test | 6 | ||||
-rw-r--r-- | tests/utf.test | 12 | ||||
-rw-r--r-- | tests/winFCmd.test | 9 |
4 files changed, 36 insertions, 7 deletions
diff --git a/tests/fileName.test b/tests/fileName.test index ce89623..7f983a7 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -778,6 +778,8 @@ test filename-11.16 {Tcl_GlobCmd} { } {globTest} set globname "globTest" set horribleglobname "glob\[\{Test" +set tildeglobname "./~test.txt" + test filename-11.17 {Tcl_GlobCmd} {unix} { lsort [glob -directory $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -917,11 +919,12 @@ test filename-11.21.1 {Tcl_GlobCmd} -body { } -result {{[tcl].testremains}} # Get rid of file/dir if it exists, since it will have been left behind by a # previous failed run. -if {[file exists $horribleglobname]} { - file delete -force $horribleglobname -} +file delete -force $horribleglobname file rename globTest $horribleglobname set globname $horribleglobname +file delete -force $tildeglobname +close [open $tildeglobname w] + test filename-11.22 {Tcl_GlobCmd} {unix} { lsort [glob -dir $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -1040,7 +1043,9 @@ test filename-11.41 {Tcl_GlobCmd} -body { test filename-11.42 {Tcl_GlobCmd} -body { set res [list] foreach f [glob -dir [pwd] *] { - lappend res [file tail $f] + set f [file tail $f] + regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention). + lappend res $f } list $res [glob *] } -match compareWords -result equal @@ -1080,8 +1085,9 @@ test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body { } -result {bad argument to "-types": abcde} file rename $horribleglobname globTest +file delete -force $tildeglobname set globname globTest -unset horribleglobname +unset horribleglobname tildeglobname test filename-12.1 {simple globbing} {unixOrPc} { glob {} diff --git a/tests/tcltest.test b/tests/tcltest.test index cd3c621..286f017 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -551,6 +551,7 @@ switch -- $::tcl_platform(platform) { file attributes $notWriteableDir -permissions 00555 } default { + # note in FAT/NTFS we won't be able to protect directory with read-only attribute... catch {file attributes $notWriteableDir -readonly 1} catch {testchmod 0 $notWriteableDir} } @@ -567,9 +568,10 @@ test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { # This constraint doesn't go at the top of the file so that it doesn't # interfere with tcltest-5.5 testConstraint notFAT [expr { - ![string match "FAT*" [lindex [file system $notWriteableDir] 1]] + ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] + || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] -# FAT permissions are fairly hopeless; ignore this test if that FS is used +# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { -constraints {unixOrPc notRoot notFAT} -body { diff --git a/tests/utf.test b/tests/utf.test index af471e1..39818cc 100644 --- a/tests/utf.test +++ b/tests/utf.test @@ -250,6 +250,9 @@ test utf-11.3 {Tcl_UtfToUpper} { test utf-11.4 {Tcl_UtfToUpper} { string toupper \u01e3ab } \u01e2AB +test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} { + string toupper \u10d0\u1c90 +} \u1c90\u1c90 test utf-12.1 {Tcl_UtfToLower} { string tolower {} @@ -263,6 +266,9 @@ test utf-12.3 {Tcl_UtfToLower} { test utf-12.4 {Tcl_UtfToLower} { string tolower \u01e2AB } \u01e3ab +test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} { + string tolower \u10d0\u1c90 +} \u10d0\u10d0 test utf-13.1 {Tcl_UtfToTitle} { string totitle {} @@ -276,6 +282,12 @@ test utf-13.3 {Tcl_UtfToTitle} { test utf-13.4 {Tcl_UtfToTitle} { string totitle \u01f3ab } \u01f2ab +test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { + string totitle \u10d0\u1c90 +} \u10d0\u1c90 +test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} { + string totitle \u1c90\u10d0 +} \u1c90\u10d0 test utf-14.1 {Tcl_UtfNcasecmp} { string compare -nocase a b diff --git a/tests/winFCmd.test b/tests/winFCmd.test index 294745c..e9886dc 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -1056,6 +1056,15 @@ test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { } -cleanup { file delete -force -- c:/td1 } -result {c:/td1} +test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { + catch {file delete -force -- $::env(TEMP)/td1} +} -constraints {win} -body { + createfile $::env(TEMP)/td1 {} + string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ + [string tolower [file normalize $::env(TEMP)]/td1]] +} -cleanup { + file delete -force -- $::env(TEMP)/td1 +} -result 1 test winFCmd-12.7 {ConvertFileNameFormat} -body { string tolower [file attributes //bisque/tcl/ws -longname] } -constraints {nonPortable win} -result {//bisque/tcl/ws} |