File: mktest-rcs.tcl

package info (click to toggle)
tkrev 9.6.1-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 2,972 kB
  • sloc: tcl: 30,582; sh: 2,296; makefile: 22; csh: 14
file content (347 lines) | stat: -rwxr-xr-x 8,411 bytes parent folder | download
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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" -- ${1+"$@"}


proc cleanup_old {} {

  set oldirs [glob -nocomplain -- rcs_test*]
  foreach od $oldirs {
    puts "Deleting $od"
    file delete -force $od
  }
  puts "==============================="
}

proc checkin_files {topdir} {
  global WD
  
  puts "==============================="
  file mkdir RCS

  puts "IMPORTING FILES $topdir"
  # Check in files
  foreach n {1 2 3 4} {
    set filename File$n.txt
    set rcsfile RCS/$filename,v
    # Escape the spaces in filenames
    regsub -all { } $filename {\ } filename
    regsub -all { } $rcsfile {\ } rcsfile
    set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename $rcsfile"
    puts "$exec_cmd"
    set ret [catch {eval "exec $exec_cmd"} out]
    puts $out
  }
  foreach filename { FTags.txt "File Spc.txt" } {
    set rcsfile RCS/$filename,v
    # Escape the spaces in filenames
    regsub -all { } $filename {\ } filename
    regsub -all { } $rcsfile {\ } rcsfile
    set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename $rcsfile"
    puts "$exec_cmd"
    set ret [catch {eval "exec $exec_cmd"} out]
    puts $out
  }
  foreach D {Dir1 "Dir 2"} {
    puts $D
    cd $D
    file mkdir RCS
    foreach n {1 2 " 3"} {
      set rcsfile RCS/F$n.txt,v
      # Escape the spaces in filenames
      regsub -all { } F$n.txt {\ } F$n.txt
      regsub -all { } $rcsfile {\ } rcsfile
      set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" F$n.txt $rcsfile"
      puts "$exec_cmd"
      set ret [catch {eval "exec $exec_cmd"} out]
      puts $out
    }
    cd $topdir
  }
}

proc checkout_files {topdir} {
  global WD

  cd $topdir
  puts "==============================="
  puts "CHECKING OUT"

  set globpat "RCS/*,v"
  regsub -all { } $globpat {\ } globpat
  set exec_cmd "co -f -l [glob $globpat]"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out

  foreach D {Dir1 "Dir 2"} {
    cd $D
    set globpat "RCS/*,v"
    regsub -all { } $globpat {\ } globpat
    set exec_cmd "co -f -l [glob $globpat]"
    puts "$exec_cmd"
    set ret [catch {eval "exec $exec_cmd"} out]
    puts $out
    cd $topdir
  }
  puts "CHECKOUT FINISHED"
}

proc tag {tag revision obj} {
  set exec_cmd "rcs -n$tag:$revision $obj"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc writefile {filename string} {
  puts " append \"$string\" to $filename"
  set fp [open "$filename" a]
  puts $fp $string
  close $fp
}

proc write_funny_files {} {
  puts "Creating utf-8 file"
  set fid1 [open "code-utf-8.txt" w]
  chan configure $fid1 -encoding utf-8
  puts $fid1 "€20" 
  chan close $fid1

  puts "Creating iso8859-1 file"
  set fid2 [open "code-iso8859-1.txt" w]
  chan configure $fid2 -encoding iso8859-1
  puts $fid1 "Copyright © 2025"
  chan close $fid2
}

proc addfile {filename} {

  puts "Add $filename"
  set exec_cmd "ci -u -i -t-small_text_file -m\"Initial\\\ checkin\" $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  set exec_cmd "co -l $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc delfile {filename} {

  puts "Delete $filename"
  file delete $filename
  file delete RCS/$filename,v
}

proc lock {filename} {

  puts "Lock $filename"
  set exec_cmd "rcs -l $filename"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc getrev {filename} {
  # Find out current revision

  set exec_cmd "rcs log -b $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  #puts $out
  foreach logline [split $out "\n"] {
    if {[string match "revision *" $logline]} {
      set latest [lindex $logline 1]
      break
    }
  }
  puts "latest rev is $latest"
  return $latest
}

proc conflict {filename} {
  # Create a conflict

  set latest [getrev $filename]
  # Save a copy
  file copy $filename Ftmp.txt
  # Make a change
  set exec_cmd "rcs -l $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  file attributes $filename -permissions u+w
  writefile $filename "Conflict A"
  set exec_cmd "ci -m\"change1\" $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Check out previous revision
  set exec_cmd "co -l -r$latest $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Make a different change (we hope)
  file delete -force -- $filename
  file rename Ftmp.txt $filename
  file attributes $filename -permissions u+w
  writefile $filename "Conflict B"
  # When we check in a conflicting version, it creates
  # a branch
  set exec_cmd "ci -m\"change2\\\ conflicting\" $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Check out the branch
  set exec_cmd "co -r1.2.1 $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc commit {comment} {
  puts "COMMIT"
  puts [pwd]
  set tmpfile "list.tmp"
  file delete -force $tmpfile

  puts "Finding RCS files"
  if {[ info exists env(SystemDrive) ]} {
    puts "Must be a PC"
    set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out]
  } else {
    set ret [catch {eval "exec find . -name F*.txt -o -name RCS -prune -a -type f > $tmpfile"} out]
  }
  if {$ret} {
    puts $out
    puts "Find failed"
    exit 1
  }
  puts "CHECKING IN FILES"
  regsub -all { } $comment {_} comment
  set fl [open $tmpfile r]
  while { [gets $fl item] >= 0} {
    regsub -all { } $item {\ } filename
    regsub -all { } $comment {\\\ } comment
    #set exec_cmd "ci -u -t-small_text_file -m\"$comment\" $filename"
puts " $filename"
    set exec_cmd "ci -u -m\"$comment\" \"$filename\""
    puts $exec_cmd
    set ret [catch {eval "exec $exec_cmd"} out]
    puts $out
  }
  close $fl
  file delete -force $tmpfile
}

proc mkfiles {topdir} {
  global WD

  puts "MAKING FILETREE"
  file mkdir "$topdir"
  cd $topdir

  # Make some files each containing a random word
  foreach n {1 2 3 4} {
    writefile File$n.txt "Initial"
  }
  writefile "File Spc.txt" "Initial"
  writefile FTags.txt "Initial"
  write_funny_files
  foreach D {Dir1 "Dir 2"} {
    puts $D
    file mkdir $D
    cd $D
    foreach n {1 2 " 3"} {
      writefile F$n.txt "Initial"
    }
    cd $topdir
  }
  # Plain, empty directory
  file mkdir Dir3
  file mkdir "Dir1/New dir"
}

proc modfiles {string} {
  global tcl_platform

  puts "MODIFYING FILES"
  set tmpfile "list.tmp"
  file delete -force $tmpfile

  puts "Finding RCS files"
  if {$tcl_platform(platform) eq "windows"} {
    puts "Must be a PC"
    set ret [catch {eval "exec [auto_execok dir] /b F*.txt /s > $tmpfile"} out]
  } else {
    set ret [catch {eval "exec find . -name F*.txt -o -name RCS -prune -a -type f > $tmpfile"} out]
  }
  if {$ret} {
    puts $out
    puts "Find failed"
    exit 1
  }
  set fl [open $tmpfile r]
  while { [gets $fl item] >= 0} {
    # Why didn't co -l make it writeable?
    file attributes $item -permissions u+w
    writefile $item "$string"
  }
  close $fl
  file delete -force $tmpfile
}

##############################################

if [file isdirectory RCS] {
  puts "Please don't do that here.  There's already an RCS directory."
  exit 1
}

set WD [pwd]
set testdir "$WD/rcs_test"
cleanup_old
mkfiles $testdir
checkin_files $testdir
checkout_files $testdir

puts "==============================="
puts "First revision"
puts "** modfiles"
modfiles "Main 1"
puts "** commit"
commit "First Revision"
puts "** writefile"
writefile Fnew.txt "Main 1"
puts "** addfile"
addfile Fnew.txt

puts "==============================="
puts "Second revision"
checkout_files $testdir
modfiles "Main 2"
commit "Second revision"
foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} {
  tag "tag_$t" 1.2 FTags.txt
}
tag "one" 1.2 "Dir1/F1.txt"

puts "==============================="
puts "Making Uncommitted changes"
#Local only
writefile FileLocal.txt "Pending"
# Deleted
delfile File3.txt
# Modify
file attributes File2.txt -permissions u+w
writefile File2.txt "Pending"
file attributes F-utf-8.txt -permissions u+w
writefile "F-utf-8.txt" "\xA53378" "utf-8"
file attributes F-iso8859-1.txt -permissions u+w
writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1"
lock File2.txt
# Conflict
puts "** conflict"
conflict Fnew.txt
cd $WD