1# 2# ftrunc.test 3# 4# Tests for the ftruncate command. 5#--------------------------------------------------------------------------- 6# Copyright 1992-1999 Karl Lehenbauer and Mark Diekhans. 7# 8# Permission to use, copy, modify, and distribute this software and its 9# documentation for any purpose and without fee is hereby granted, provided 10# that the above copyright notice appear in all copies. Karl Lehenbauer and 11# Mark Diekhans make no representations about the suitability of this 12# software for any purpose. It is provided "as is" without express or 13# implied warranty. 14#------------------------------------------------------------------------------ 15# $Id: ftrunc.test,v 1.3 2002/04/04 06:10:30 hobbs Exp $ 16#------------------------------------------------------------------------------ 17# 18 19if {[cequal [info procs Test] {}]} { 20 source [file join [file dirname [info script]] testlib.tcl] 21} 22 23TestRemove TRUNCATE.TMP 24 25proc CreateTmpFile {name size} { 26 set fh [open $name w] 27 puts -nonewline $fh [replicate X $size] 28 close $fh 29 if {[file size $name] != $size} { 30 error "CreateTmpFile: [file size $name] != $size" 31 } 32} 33 34test filecmds-7.1 {ftruncate tests} { 35 list [catch {ftruncate} msg] $msg 36} {1 {wrong # args: ftruncate [-fileid] file newsize}} 37 38test filecmds-7.2 {ftruncate tests} { 39 list [catch {ftruncate TRUNCATE.TMP 10 1000 200} msg] $msg 40} {1 {wrong # args: ftruncate [-fileid] file newsize}} 41 42test filecmds-7.3 {ftruncate tests} { 43 list [catch {ftruncate -fileid 10} msg] $msg 44} {1 {wrong # args: ftruncate [-fileid] file newsize}} 45 46test filecmds-7.4 {ftruncate tests} { 47 list [catch {ftruncate -fileid TRUNCATE.TMP 10 1000 200} msg] $msg 48} {1 {wrong # args: ftruncate [-fileid] file newsize}} 49 50test filecmds-7.5 {ftruncate tests} {need_truncate} { 51 list [catch {ftruncate NOTHERE.TMP 10} msg] [string tolower $msg] 52} {1 {nothere.tmp: no such file or directory}} 53 54test filecmds-7.6 {ftruncate tests} {need_truncate} { 55 CreateTmpFile TRUNCATE.TMP 1000 56 set sizes {} 57 ftruncate TRUNCATE.TMP 500 58 lappend sizes [file size TRUNCATE.TMP] 59 ftruncate TRUNCATE.TMP 50 60 lappend sizes [file size TRUNCATE.TMP] 61 set sizes 62} {500 50} 63 64test filecmds-7.7 {ftruncate tests} {need_truncate} { 65 CreateTmpFile TRUNCATE.TMP 1000 66 set sizes {} 67 ftruncate TRUNCATE.TMP 1000 68 lappend sizes [file size TRUNCATE.TMP] 69 ftruncate TRUNCATE.TMP 0 70 lappend sizes [file size TRUNCATE.TMP] 71 set sizes 72} {1000 0} 73 74test filecmds-7.7.1 {ftruncate tests} {pcOnly} { 75 list [catch {ftruncate NOTHERE.TMP 10} msg] $msg 76} {1 {truncating files by path is not available on this system}} 77 78test filecmds-7.8 {ftruncate tests} {need_ftruncate} { 79 list [catch {ftruncate -fileid TRUNCATE.TMP 1000} msg] $msg 80} {1 {can not find channel named "TRUNCATE.TMP"}} 81 82test filecmds-7.9 {ftruncate tests} {need_ftruncate} { 83 CreateTmpFile TRUNCATE.TMP 1000 84 set sizes {} 85 set fh [open TRUNCATE.TMP r+] 86 ftruncate -fileid $fh 500 87 lappend sizes [file size TRUNCATE.TMP] [fstat $fh size] 88 ftruncate -fileid $fh 50 89 lappend sizes [file size TRUNCATE.TMP] [fstat $fh size] 90 close $fh 91 set sizes 92} {500 500 50 50} 93 94test filecmds-7.10 {ftruncate tests} {need_ftruncate} { 95 CreateTmpFile TRUNCATE.TMP 1000 96 set sizes {} 97 set fh [open TRUNCATE.TMP r+] 98 ftruncate -fileid $fh 1000 99 lappend sizes [file size TRUNCATE.TMP] [fstat $fh size] 100 ftruncate -fileid $fh 0 101 lappend sizes [file size TRUNCATE.TMP] [fstat $fh size] 102 close $fh 103 set sizes 104} {1000 1000 0 0} 105 106test filecmds-7.10.1 {ftruncate tests} {pcOnly} { 107 set fh [open TRUNCATE.TMP w] 108 set result [list [catch {ftruncate -fileid $fh 0} msg] $msg] 109 close $fh 110 set result 111} {0 {}} 112 113rename CreateTmpFile {} 114TestRemove TRUNCATE.TMP 115 116# cleanup 117::tcltest::cleanupTests 118return 119