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