File: test1.tcl

package info (click to toggle)
hfsutils 3.2.6-16
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 1,680 kB
  • sloc: ansic: 12,858; tcl: 1,937; makefile: 566; sh: 156; perl: 29
file content (119 lines) | stat: -rw-r--r-- 2,151 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#
# NAME:		test1
# DESCRIPTION:	fragment two files to excess
#
proc test1 {} {
    global curvol

    set block [block]
    set max 250

    mkvol

    puts "Creating files..."

    set file1 "Foo"
    set file2 "Bar"

    hcreate $file1
    hcreate $file2

    puts "Fragmenting files..."

    set count 0

    for {set i 0} {$i < $max} {incr i} {
	set len [string length "$i "]

	if {[expr $count + $len] > 79} {
	    puts ""
	    set count 0
	}

	puts -nonewline "$i "
	flush stdout
	incr count $len

	set file [$curvol open $file1]

	$file fork data
	$file seek 0 end
	$file write $block

	$file fork rsrc
	$file seek 0 end
	$file write $block

	$file close

	set file [$curvol open $file2]

	$file fork data
	$file seek 0 end
	$file write $block

	$file fork rsrc
	$file seek 0 end
	$file write $block

	$file close
    }

    puts ""

    remount

    puts "Comparing file data forks..."

    set fh1 [$curvol open $file1]
    set fh2 [$curvol open $file2]

    $fh1 fork data
    $fh2 fork data

    for {set i 0} {$i < $max} {incr i} {
	set data [$fh1 read [string length $block]]
	if {[string compare $data $block]} {
	    error "$fh1 ($file1) fork data block $i differs"
	}

	set data [$fh2 read [string length $block]]
	if {[string compare $data $block]} {
	    error "$fh2 ($file2) fork data block $i differs"
	}
    }

    if {[string length [$fh1 read 1]]} {
	error "$fh1 ($file1) bad data fork length"
    }
    if {[string length [$fh2 read 1]]} {
	error "$fh2 ($file2) bad data fork length"
    }

    puts "Comparing file resource forks..."

    $fh1 fork rsrc
    $fh2 fork rsrc

    for {set i 0} {$i < $max} {incr i} {
	set data [$fh1 read [string length $block]]
	if {[string compare $data $block]} {
	    error "$fh1 ($file1) fork rsrc block $i differs"
	}

	set data [$fh2 read [string length $block]]
	if {[string compare $data $block]} {
	    error "$fh2 ($file2) fork rsrc block $i differs"
	}
    }

    if {[string length [$fh1 read 1]]} {
	error "$fh1 ($file1) bad resource fork length"
    }
    if {[string length [$fh2 read 1]]} {
	error "$fh2 ($file2) bad resource fork length"
    }

    $fh1 close
    $fh2 close
}