#!/usr/bin/tclsh # # This script generates the requirements traceability matrix and does # other processing related to requirements and coverage analysis. # # Get a list of source HTML files. # set filelist [lsort [glob -nocomplain doc/*.html doc/c3ref/*.html doc/syntax/*.html]] foreach exclude {doc/capi3ref.html doc/changes.html} { set i [lsearch $filelist $exclude] set filelist [lreplace $filelist $i $i] } # Initialize the database connection. # sqlite3 db docinfo.db db eval { BEGIN; DELETE FROM requirement; DELETE FROM reqsrc; } # Extract requirement text from all of the HTML files in $filelist # # Requirements text is text between "^" and "." or between "^(" and ")^". # Requirement text is normalized by removing all HTML markup, removing # all whitespace from the beginning and end, and converting all internal # whitespace sequences into a single space character. # # Syntax diagrams are considered their own requirement if they are # embedded using markup of the following patter: # # # # The requirement table of the docinfo.db is populated with requirement # information. See the schema.tcl source file for a definition of the # requirment table. # puts -nonewline "Scanning documentation for testable statements" flush stdout foreach file $filelist { if {$file=="doc/fileformat.html" && [lsearch $filelist doc/fileformat2.html]>=0} { continue } puts -nonewline . # puts "$file..." flush stdout set in [open $file] set x [read $in [file size $file]] close $in set orig_x $x set origlen [string length $x] regsub {^doc/} $file {} srcfile set seqno 0 while {[string length $x]>0 && [regsub {^.*?\^} $x {} nx]} { set c [string index $nx 0] set seqno [expr {$origlen - [string length $nx]}] set req {} if {$c=="("} { regexp {^\((([^<]|<.+?>)*?)\)\^} $nx all req regsub {^\((([^<]|<.+?>)*?)\)\^} $nx {} nx } else { regexp {^([^<]|<.+?>)*?\.} $nx req regsub {^([^<]|<.+?>)*?\.} $nx {} nx } if {$req==""} { puts "$srcfile: bad requirement: [string range $nx 0 40]..." set x $nx continue } set orig [string trim $req] regsub -all {<.+?>} $orig {} req regsub -all {\s+} [string trim $req] { } req set req [string map {< < > > [ [ ] ] & &} $req] set req [string trim $req] set reqno R-[md5-10x8 $req] db eval {SELECT srcfile AS s2, reqtext as r2 FROM requirement WHERE reqno=$reqno} { puts "$srcfile: duplicate [string range $reqno 0 12] in $s2: \[$r2\]" } db eval { INSERT OR IGNORE INTO requirement (reqno, reqtext, origtext, reqimage,srcfile,srcseq) VALUES($reqno,$req, $orig, 0, $srcfile,$seqno); } db eval { INSERT OR IGNORE INTO reqsrc(srcfile, srcseq, reqno) VALUES($srcfile, $seqno, $reqno) } set x $nx } set x $orig_x unset orig_x while {[string length $x]>0 && [regexp {^(.+?)(" if {![file exists doc/$image]} { puts stderr "No such image: doc/$image" continue } set reqno R-[md5file-10x8 doc/$image] if {[string match *syntax/*.html $srcfile]} { db eval {DELETE FROM requirement WHERE reqno=$reqno} } db eval { INSERT OR IGNORE INTO requirement (reqno, reqtext, origtext, reqimage,srcfile,srcseq) VALUES($reqno,$req, $orig, 1, $srcfile,$seqno); } db eval { INSERT OR IGNORE INTO reqsrc(srcfile, srcseq, reqno) VALUES($srcfile,$seqno,$reqno) } } } } db eval COMMIT set cnt [db one {SELECT count(*) FROM requirement}] set evcnt [db one { SELECT count(*) FROM requirement WHERE reqno IN (SELECT reqno FROM evidence) }] set evpct [format {%.1f%%} [expr {$evcnt*100.0/$cnt}]] puts "\nFound $cnt testable statements. Evidence exists for $evcnt or $evpct" # Report all evidence for which there is no corresponding requirement. # Such evidence is probably "stale" - the requirement text has changed but # the evidence text did not. # db eval { SELECT reqno, srcfile, srcline FROM evidence WHERE reqno NOT IN (SELECT reqno FROM requirement) } { puts "ERROR: stale evidence at $srcfile:$srcline - $reqno" } ######################################################################## # Header output routine adapted from wrap.tcl. Keep the two in sync. # # hd_putsin4 is like puts except that it removes the first 4 indentation # characters from each line. It also does variable substitution in # the namespace of its calling procedure. # proc putsin4 {fd text} { regsub -all "\n " $text \n text puts $fd [uplevel 1 [list subst -noback -nocom $text]] } # A procedure to write the common header found on every HTML file on # the SQLite website. # proc write_header {path fd title} { puts $fd {} puts $fd {
} puts $fd "tcl | slt | th3 | src | any | |||
---|---|---|---|---|---|---|---|
$srcfile | " set ev(tcl) 0 set ev(th3) 0 set ev(src) 0 set ev(slt) 0 set ev(any) 0 db eval { SELECT count(distinct reqno) AS cnt, srcclass FROM evidence WHERE reqno IN srcreq GROUP BY srcclass } { set ev($srcclass) $cnt incr total($srcclass) $cnt } db eval { SELECT count(distinct reqno) AS cnt FROM evidence WHERE reqno IN srcreq } { set ev(any) $cnt incr total(any) $cnt } foreach srcclass {tcl slt th3 src any} { set cnt $ev($srcclass) if {$cnt==$totalcnt} { set cx evok } elseif {$cnt>=0.75*$totalcnt} { set cx evl3 } elseif {$cnt>=0.5*$totalcnt} { set cx evl2 } elseif {$cnt>=0.25*$totalcnt} { set cx evl1 } elseif {$cnt>0} { set cx evl0 } else { set cx evnil } set amt [format {%3d/%-3d} $cnt $totalcnt] set amt [string map {{ } { }} $amt] puts $out "$amt | " } regsub -all {[^a-zA-Z0-9]} [file tail [file root $srcfile]] _ docid puts $out "summary | " puts $out "details | ||||
Overall Coverage" set totalcnt $total(all) foreach srcclass {tcl slt th3 src any} { set cnt $total($srcclass) if {$cnt==$totalcnt} { set cx evok } elseif {$cnt>=0.75*$totalcnt} { set cx evl3 } elseif {$cnt>=0.5*$totalcnt} { set cx evl2 } elseif {$cnt>=0.25*$totalcnt} { set cx evl1 } elseif {$cnt>0} { set cx evl0 } else { set cx evnil } set amt [format {%5.1f%% } [expr {($cnt*100.0)/$totalcnt}]] set amt [string map {{ } { }} $amt] puts $out " | $amt | " } puts $out
$reqno" set ev(tcl) 0 set ev(slt) 0 set ev(th3) 0 set ev(src) 0 db eval { SELECT count(*) AS cnt, srcclass FROM evidence WHERE reqno=$reqno GROUP BY srcclass } { set ev($srcclass) $cnt } set proof($reqno) 0 foreach srcclass {tcl slt th3 src} { set cnt $ev($srcclass) if {$cnt} { set cx evok incr proof($reqno) } else { set cx evnil } puts $out "$srcclass" } puts $out "
" if {$canonical!=""} { puts $out "Canonical usage: $canonical
" } set orig [string map -nocase {$orig
" set sepdb eval { SELECT srccat || '/' || srcfile || ':' || srcline AS x, url FROM evidence WHERE reqno=$reqno ORDER BY x; } { if {$url!=""} { puts $out "$sep$x" } else { puts $out "$sep$x" } set sep " " } # Generate text suitable for copy-paste into source documents as # evidence that the requirement is satisfied. # set abbrev [string range $reqno 0 12] puts $out "
/* IMP: $abbrev */" if {[regexp {^syntax diagram } $reqtext]} { puts $out "
# EVIDENCE-OF: $abbrev -- $reqtext" } else { puts $out "
" wrap_in_comment $out # \ "EVIDENCE-OF: $abbrev [string map {& & < < > >} $reqtext]" puts $out "" } } close $out } # Summary matrixes for each document. # foreach srcfile $srclist { set has_req($srcfile) 1 regsub -all {[^a-zA-Z0-9]} [file tail [file root $srcfile]] _ docid set fn matrix_s$docid.html set out [open doc/matrix/$fn w] regsub {^doc/} $srcfile {} basename write_header ../ $out "SQLite Requirement Matrix: [file tail $srcfile]" puts $out "
$reqno | " set ev(tcl) 0 set ev(slt) 0 set ev(th3) 0 set ev(src) 0 db eval { SELECT count(*) AS cnt, srcclass FROM evidence WHERE reqno=$reqno GROUP BY srcclass } { set ev($srcclass) $cnt } set proof($reqno) 0 foreach srcclass {tcl slt th3 src} { set cnt $ev($srcclass) if {$cnt} { set cx evok incr proof($reqno) } else { set cx evnil } puts $out "$srcclass | " } puts $out "" } puts $out {