Tcl Library Source Code

Check-in [f5d2be5a46]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fixed issues with repository scan - Forgot to handle trunk revision, and mixup of parent/child times and descriptions.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | tcllib-1-16-rc
Files: files | file ages | folders
SHA1: f5d2be5a46d9e17525c4ce16f131de364680a56c
User & Date: aku 2014-01-31 07:33:41.832
Context
2014-01-31
07:39
Bumped versions of modified packages and missed so far. check-in: f06124e3c3 user: aku tags: tcllib-1-16-rc
07:33
Fixed issues with repository scan - Forgot to handle trunk revision, and mixup of parent/child times and descriptions. check-in: f5d2be5a46 user: aku tags: tcllib-1-16-rc
06:31
Bumped ftp to 2.4.12, see [3b14767f50]. check-in: 6e03cd1a77 user: aku tags: tcllib-1-16-rc
Changes
Unified Diff Ignore Whitespace Patch
Changes to support/devel/sak/readme/readme.tcl.
28
29
30
31
32
33
34

35
36
37
38
39
40
41
    # Future: Consolidate with ... review ...
    # Determine which packages are potentially changed, from the set
    # of modules touched since the last release, as per the fossil
    # repository's commit log.

    set trunk     [sak::review::Leaf trunk]            ;# rid
    set release   [sak::review::YoungestOfTag release] ;# datetime

    sak::review::AllParentsAfter $trunk $release -> rid {
	sak::review::FileSet $rid -> path action {
	    lappend modifiedm [lindex [file split $path] 1]
	}
    }
    set modifiedm [lsort -unique $modifiedm]








>







28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
    # Future: Consolidate with ... review ...
    # Determine which packages are potentially changed, from the set
    # of modules touched since the last release, as per the fossil
    # repository's commit log.

    set trunk     [sak::review::Leaf trunk]            ;# rid
    set release   [sak::review::YoungestOfTag release] ;# datetime

    sak::review::AllParentsAfter $trunk $release -> rid {
	sak::review::FileSet $rid -> path action {
	    lappend modifiedm [lindex [file split $path] 1]
	}
    }
    set modifiedm [lsort -unique $modifiedm]

Changes to support/devel/sak/review/review.tcl.
67
68
69
70
71
72
73


74
75
76
77
78
79
80
	    lappend cm($themodule) $d

	    # ignore files in modules/
	    if {[llength $px] < 3} continue
	    lappend pt($themodule) [file join {*}[lrange $px 2 end]]
	}
    }



    # cleanup module list, may have duplicates
    set modifiedm [lsort -unique $modifiedm]

    array set review {}

    # package -> list(version)







>
>







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
	    lappend cm($themodule) $d

	    # ignore files in modules/
	    if {[llength $px] < 3} continue
	    lappend pt($themodule) [file join {*}[lrange $px 2 end]]
	}
    }

    Next

    # cleanup module list, may have duplicates
    set modifiedm [lsort -unique $modifiedm]

    array set review {}

    # package -> list(version)
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

proc ::sak::review::AllParentsAfter {rid cut _ rv script} {
    upvar 1 $rv therev

    array set rev {}
    set rev($rid) .
    lappend front $rid





    # Standard iterative incremental transitive-closure. We have a
    # front of revisions whose parents we take, which become the new
    # front to follow, until no parents are delivered anymore due to
    # the cutoff condition (timestamp, only the revisions coming after
    # are accepted).

    while {1} {
	set new {}
	foreach cid $front {
	    foreach pid [split [Parents $cid $cut] \n] {

		lappend new $pid





	    }
	}
	if {![llength $new]} break

	# record new parents, and make them the new starting points
	set front {}
	foreach pid $new {
	    if {[info exists rev($pid)]} continue
	    set rev($pid) .
	    lappend front $pid

	    set therev $pid
	    uplevel 1 $script
	}
    }
}

proc ::sak::review::Parents {rid cut} {
    lappend map @rid@    $rid
    lappend map @cutoff@ $cut
    F [string map $map {
	SELECT pid FROM plink

	WHERE plink.cid   = @rid@


	AND   plink.mtime > @cutoff@
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @tag@ $tag












    F [string map $map {
	SELECT event.mtime
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid







>
>
>
>











>
|
>
>
>
>
>






|




|









|
>

>
>
|






>
>
>
>
>
>
>
>
>
>
>
>







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

proc ::sak::review::AllParentsAfter {rid cut _ rv script} {
    upvar 1 $rv therev

    array set rev {}
    set rev($rid) .
    lappend front $rid

    # Initial run, for the starting revision.
    set therev   $rid
    uplevel 1 $script

    # Standard iterative incremental transitive-closure. We have a
    # front of revisions whose parents we take, which become the new
    # front to follow, until no parents are delivered anymore due to
    # the cutoff condition (timestamp, only the revisions coming after
    # are accepted).

    while {1} {
	set new {}
	foreach cid $front {
	    foreach pid [split [Parents $cid $cut] \n] {
		foreach {pid uuid mtraw mtime} [split [string trim $pid |] |] break
		lappend new $pid $mtime $uuid

		if {$mtraw <= $cut} {
		    puts "Overshot: $rid $mtime $uuid"
		}

	    }
	}
	if {![llength $new]} break

	# record new parents, and make them the new starting points
	set front {}
	foreach {pid mtime uuid} $new {
	    if {[info exists rev($pid)]} continue
	    set rev($pid) .
	    lappend front $pid

	    set therev   $pid
	    uplevel 1 $script
	}
    }
}

proc ::sak::review::Parents {rid cut} {
    lappend map @rid@    $rid
    lappend map @cutoff@ $cut
    F [string map $map {
	SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
	FROM  plink, blob, event
	WHERE plink.cid   = @rid@
	AND   plink.pid = blob.rid
	AND   plink.pid = event.objid
	AND   event.mtime > @cutoff@
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @tag@ $tag
    puts "last $tag = [F [string map $map {
	SELECT datetime (event.mtime)
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid
	AND   event.type      = 'ci'
	ORDER BY event.mtime DESC
	LIMIT 1
	;
    }]]"
    F [string map $map {
	SELECT event.mtime
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid