24
25
26
27
28
29
30
31
32
33
34
35
36
37
|
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
+
+
+
+
+
+
+
|
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::integrity {
# # ## ### ##### ######## #############
## Public API
typemethod assert {expression failmessage} {
set ok [uplevel 1 [list ::expr $expression]]
if {$ok} return
trouble internal [uplevel 1 [list ::subst $failmessage]]
return
}
typemethod strict {} {
log write 4 integrity {Check database consistency}
set n 0
AllButMeta
Meta
|
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
|
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
|
-
+
-
+
-
+
|
proc Check {header label sql} {
upvar 1 n n
set ok 1
foreach {fname revnr} [state run $sql] {
set ok 0
trouble fatal "$fname <$revnr> $label"
}
log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
proc CheckCS {header label sql} {
upvar 1 n n
set ok 1
foreach {ctype cid} [state run $sql] {
set ok 0
trouble fatal "<$ctype $cid> $label"
}
log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
proc CheckInCS {header label sql} {
upvar 1 n n
set ok 1
foreach {cstype csid fname revnr} [state run $sql] {
set ok 0
set b "<$cstype $csid>"
trouble fatal "$fname <$revnr> [string map [list @ $b] $label]"
}
log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header"
log write 5 integrity {\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header}
return
}
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
|