Tcl Library Source Code

Check-in [f5d2be5a46]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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.
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
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
Hide Diffs Unified Diffs 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
...
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
	    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)
................................................................................

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 @[email protected]    $rid
    lappend map @[email protected] $cut
    F [string map $map {
	SELECT pid FROM plink

	WHERE plink.cid   = @[email protected]


	AND   plink.mtime > @[email protected]
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @[email protected] $tag












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






>
>







 







>
>
>
>











>
|
>
>
>
>
>






|




|









|
>

>
>
|






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







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
...
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
	    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)
................................................................................

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 @[email protected]    $rid
    lappend map @[email protected] $cut
    F [string map $map {
	SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
	FROM  plink, blob, event
	WHERE plink.cid   = @[email protected]
	AND   plink.pid = blob.rid
	AND   plink.pid = event.objid
	AND   event.mtime > @[email protected]
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @[email protected] $tag
    puts "last $tag = [F [string map $map {
	SELECT datetime (event.mtime)
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@[email protected]'
	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-' || '@[email protected]'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid