File: mktest-cvs.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 (481 lines) | stat: -rwxr-xr-x 11,660 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
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" -- ${1+"$@"}


proc cleanup_old {root} {
  if {[ file isdirectory $root ]} {
    puts "Deleting $root"
    file delete -force $root
  }
  set oldirs [glob -nocomplain -- cvs_test*]
  foreach od $oldirs {
    puts "Deleting $od"
    file delete -force $od
  }
  puts "==============================="
}

proc repository {Root topdir} {
  global env
  global WD

  puts "==============================="
  puts "MAKING REPOSITORY $env(CVSROOT)"

  # Create the repository
  file mkdir $Root
  set exec_cmd "cvs -d $env(CVSROOT) init"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  if {$ret} {
    puts $out
    puts "COULD NOT CREATE REPOSITORY $env(CVSROOT)"
    exit 1
  }
  puts "CREATED $env(CVSROOT)"

  puts "==============================="
  puts "IMPORTING FILETREE"
  cd $topdir
  # Import it
  set exec_cmd "cvs -d $env(CVSROOT) import -m \"Imported\" $topdir BEGIN baseline-1_1_1"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  puts "IMPORT FINISHED"
  cd $WD
}

# Make something that uses the CVSROOT/modules functionality
proc module_file {} {
  global env
  global WD

  puts "==============================="
  puts "EDITING MODULE FILE"

  set exec_cmd "cvs -d $env(CVSROOT) co CVSROOT/modules"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  if {$ret} {
    puts $out
    puts "COULD NOT CHECK OUT CVSROOT/modules"
    exit 1
  }
  cd CVSROOT
  set mf [open "modules" a]
  puts $mf ""
  puts $mf "#D\tcvs_test"
  puts $mf "#M\tcvs_test\tImported"
  puts $mf "cvs_test\tcvs_test"
  close $mf
  set exec_cmd "cvs ci -m\"Add\\\ a\\\ module\\\ and\\\ a\\\ #D\\\ line\" modules"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  if {$ret} {
    puts $out
    puts "COULD NOT CHECK IN CVSROOT/modules"
    cd $WD
    exit 1
  }
  cd $WD
}

proc checkout_branch {proj tag} {
  global env

  puts "==============================="
  puts "CHECKING OUT $tag"
  # Check out 
  if {$tag eq "trunk"} {
    set exec_cmd "cvs -d $env(CVSROOT) co -d cvs_test_$tag $proj"
  } else {
    set exec_cmd "cvs -d $env(CVSROOT) co -d cvs_test_$tag -r $tag $proj"
  }
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  puts "CHECKOUT FINISHED"
}

proc newbranch {proj oldtag newtag} {
  global env

  set exec_cmd "cvs -d $env(CVSROOT) rtag -r $oldtag -b $newtag $proj"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out

  puts "CHECKING OUT BRANCH"
  set exec_cmd "cvs -d $env(CVSROOT) co -r $newtag -d ${proj}_$newtag cvs_test"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
}

proc empty_branch {proj oldtag newtag} {
  global env

  set exec_cmd "cvs -d $env(CVSROOT) rtag -r $oldtag -b $newtag $proj"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc tag {tag obj} {
  set exec_cmd "cvs tag -F $tag $obj"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc merge {fromtag totag} {
  global WD

  cd cvs_test_$totag
  # This will fail if there are conflicts
  set exec_cmd "cvs update -d -j$fromtag ."
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  commit "Merge $fromtag to $totag"
  set date  [clock format [clock seconds] -format "%H-%M-%S"]
  # First, the "from" file that's not in this branch (needs -r)
  set exec_cmd "cvs tag -F -r$fromtag mergeto_${totag}_$date ."
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Now, the version that's in the current branch
  set exec_cmd "cvs tag -F mergefrom_${fromtag}_$date ."
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Clean up the merge files
  file delete [glob -nocomplain -- .#* */.#*]

  cd $WD
}

proc writefile {filename string {encoding {}} } {
  puts " append \"$string\" to $filename"
  set fp [open "$filename" a]
  if {$encoding != ""} {
    chan configure $fp -encoding $encoding
  }
  puts $fp $string
  chan close $fp
}

proc addfile {filename branch} {
  puts "Add $filename on $branch"
  set exec_cmd "cvs add $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc delfile {filename branch} {
  puts "Delete $filename on $branch"
  file delete $filename
  set exec_cmd "cvs delete $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc movefile {oldname newname} {
  # remove and add. CVS has no move command
  file rename $oldname $newname
  set exec_cmd "cvs delete $oldname"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  set exec_cmd "cvs add $newname"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc commit {comment} {
  set exec_cmd "cvs commit -m \"$comment\""
  # This is so the timestamp is different from the last commit
  after 1000
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

proc mkfiles {topdir} {
  global WD

  puts "MAKING FILETREE"
  # Make some files to put in the repository
  file mkdir "$topdir"
  cd $topdir

  # Make some text files
  foreach n {1 2 3 4} {
    writefile "File$n.txt" "Initial"
  }
  writefile "File Spc.txt" "Initial"
  writefile "FTags.txt" "Initial"
  writefile "F-utf-8.txt" "\u20AC20" "utf-8"
  writefile "F-iso8859-1.txt" "Copyright \xA9 2025" "iso8859-1"
  foreach D {Dir1 "Dir 2"} {
    puts $D
    file mkdir $D
    foreach n {1 2 " 3" 4} {
      set subf [file join $D "F$n.txt"]
      writefile $subf "Initial"
    }
  }
  cd $WD
}

proc modfiles {string} {
  global tcl_platform

  set tmpfile "list.tmp"

  file delete -force $tmpfile
  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 CVS -prune -a -type f > $tmpfile"} out]
  }
  if {$ret} {
    puts "Find failed"
    puts $out
    exit 1
  }
  set fl [open $tmpfile r]
  while { [gets $fl item] >= 0} {
    writefile $item $string
  }
  close $fl
  file delete -force $tmpfile
}

proc getrev {filename} {
  # Find out current revision

  set exec_cmd "cvs 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
    }
  }
  return $latest
}

proc conflict {filename} {
  # Create a conflict

  set latest [getrev $filename]
  # Save a copy
  file copy $filename Ftmp.txt
  # Make a change
  writefile $filename "conflict A"
  set exec_cmd "cvs commit -m \"change1\" $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
  # Check out latest revision
  set exec_cmd "cvs update -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
  writefile $filename "conflict B"
  # Check out head, which now conflicts with our change
  set exec_cmd "cvs update -r HEAD $filename"
  puts "$exec_cmd"
  set ret [catch {eval "exec $exec_cmd"} out]
  puts $out
}

##############################################
set branching_desired 1
set leave_a_mess 1

for {set i 1} {$i < [llength $argv]} {incr i} {
  set arg [lindex $argv $i]

  switch -regexp $arg {
    {^--*nobranch} {
      set branching_desired 0
    }
    {^--*nomess} {
      set leave_a_mess 0
    }
  }
}

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

set WD [pwd]
set Root [file join $WD "CVS_REPOSITORY"]
set env(CVSROOT) ":local:$Root"

cleanup_old $Root

mkfiles "cvs_test"
repository $Root "cvs_test"
module_file
checkout_branch "cvs_test" "trunk"

puts "==============================="
puts "First revision on trunk"
cd cvs_test_trunk
writefile .cvsignore ".DS_Store"
addfile .cvsignore trunk

modfiles "Main 1"
writefile Ftrunk.txt "Main 1"
addfile Ftrunk.txt trunk
commit "First revision on trunk"
tag "tagA" "."
tag "tagC" "."
cd $WD

if {$branching_desired} {
  puts "==============================="
  puts "MAKING BRANCH A"
  newbranch cvs_test HEAD branchA
  cd $WD/cvs_test_branchA
  writefile FbranchA.txt "BranchA 1"
  addfile FbranchA.txt branchA
  commit "Add file FbranchA.txt on branch A"
  cd $WD

  puts "==============================="
  puts "First revision on Branch A"
  cd $WD/cvs_test_branchA
  modfiles "BranchA 1"
  commit "First revision on branch A"
  cd $WD

  puts "==============================="
  puts "Second revision on Branch A"
  cd $WD/cvs_test_branchA
  modfiles "BranchA 2"
  commit "Second revision on branch A"
  cd $WD

  # Branch C
  puts "==============================="
  puts "MAKING BRANCH C FROM SAME ROOT"
  newbranch cvs_test HEAD branchC
  cd $WD/cvs_test_branchC
  modfiles "BranchC 1"
  writefile FbranchC.txt "BranchC 1"
  addfile FbranchC.txt branchC
  commit "Add file FC on Branch C"
  cd $WD

  puts "==============================="
  puts "Merging BranchA to trunk"
  merge branchA trunk
  cd $WD
}

# Make more modifications on trunk
puts "==============================="
puts "Second revision on trunk"
cd $WD/cvs_test_trunk
modfiles "Main 2"
writefile "F-utf-8.txt" "\xFEi\u014B" "utf-8"
writefile "F-iso8859-1.txt" "caf\u00E9" "iso8859-1"
commit "Second revision on trunk"
foreach t {one ten one_hundred one_thousand ten_thousand one_hundred_thousand} {
  tag "tag_$t" FTags.txt
}
cd $WD

puts "==============================="
puts "Third revision on trunk"
cd $WD/cvs_test_trunk
modfiles "Main 3"
commit "Third revision on trunk"
tag "tagB" "."
tag "one" "Dir1/F1.txt"
cd $WD

if {$branching_desired} {
  # Branch off of the branch
  puts "==============================="
  puts "MAKING BRANCH AA"
  newbranch cvs_test branchA branchAA
  cd $WD/cvs_test_branchAA
  modfiles "BranchAA 1"
  writefile FbranchAA.txt "BranchAA 1"
  addfile FbranchAA.txt branchAA
  delfile Ftrunk.txt branchAA
  commit "Changes on Branch AA"
  cd $WD

  # Make another revision on branchA after
  # branchAA has branched off
  puts "==============================="
  puts "Third revision on Branch A"
  cd $WD/cvs_test_branchA
  modfiles "BranchA 3"
  commit "Third revision on Branch A"
  cd $WD

  # Branch B
  puts "==============================="
  puts "MAKING BRANCH B"
  newbranch cvs_test HEAD branchB
  cd $WD/cvs_test_branchB
  # Empty branch. Don't check out or update
  empty_branch cvs_test HEAD branchD
  modfiles "BranchB 1"
  writefile FbranchB.txt "BranchB 1"
  addfile FbranchB.txt branchB
  commit "Add file FB on Branch B"
  cd $WD
}

if {$leave_a_mess} {
  # Leave the trunk with uncommitted changes
  puts "==============================="
  puts "Making Uncommitted changes on trunk"
  cd $WD/cvs_test_trunk
  # Local only
  writefile FileLocal.txt "Pending"
  # Conflict
  conflict Ftrunk.txt
  # Newly added
  writefile FileAdd.txt "Pending"
  addfile FileAdd.txt trunk
  movefile File4.txt FileMoved.txt
  # Plain, empty directory
  file mkdir Dir3
  file mkdir "Dir1/New dir"
  # Missing
  file delete -- File3.txt trunk
  # Modify
  writefile File2.txt "Pending"
  writefile "F-utf-8.txt" "\xA53378" "utf-8"
  writefile "F-iso8859-1.txt" "\xA9 2022-2024" "iso8859-1"
  writefile "Dir1/F 3.txt" "Pending"
  delfile "Dir1/F2.txt" "Pending"
  writefile "Dir 2/F1.txt" "Pending"
  movefile "Dir1/F4.txt" "Dir1/FMoved.txt"
  cd $WD
}

# Remove the source
file delete -force -- cvs_test