# Copyright: 2021-2024 Paul Obermeier (obermeier@poSoft.de)
# Distributed under BSD license.

set opts(Verbose) false
set opts(Delete)  true

set opts(RunAuto)     "auto"
set opts(RunTests)    true
set opts(RunCoverage) true

proc PrintUsage { progName { msg "" } } {
    global opts nsAvailList

    puts ""
    if { $msg ne "" } {
        puts "Error: $msg"
    }
    puts ""
    puts "Usage: $progName \[Options\]"
    puts ""
    puts "Run the test programs and code coverage checks."
    puts ""
    puts "Options:"
    puts "  --help    : Display this usage message and exit."
    puts "  --verbose : Show the detailed results of the tests. (Default: No)"
    puts "  --noauto  : Do not run in automatic mode. (Default: Run automatic)"
    puts "  --notests : Do not run the tests. (Default: Run tests)"
    puts "  --nocover : Do not run the coverage checks. (Default: Run coverage)"
    puts "  --nodelete: Do not delete test output files. (Default: Yes)"
    puts ""
}

proc RunTest { testFile } {
    global opts

    puts "Running test $testFile ..."
    set catchVal [catch {exec -ignorestderr $::tclExe $testFile $opts(RunAuto) 2>@1 } retVal optionsDict]
    if { $catchVal || [string match "*Error:*" $retVal] } {
        set msg "Unknown error"
        if { $catchVal } {
            set fullErrorInfo [dict get $optionsDict -errorinfo]
            foreach line [split $fullErrorInfo "\n"] {
                if { [string match "*Error:*" $line] } {
                    set msg $line
                    break
                }
            }
        } else {
            foreach line [split $retVal "\n"] {
                if { [string match "*Error:*" $line] } {
                    set msg $line
                }
            }
        }
        puts "Test $testFile failed: $msg"
        puts ""
    } else {
        if { $opts(Verbose) } {
            puts $retVal
            puts ""
        }
    }
}

set curArg 0
while { $curArg < $argc } {
    set curParam [lindex $argv $curArg]
    if { [string compare -length 1 $curParam "-"]  == 0 || \
         [string compare -length 2 $curParam "--"] == 0 } {
        set curOpt [string tolower [string trimleft $curParam "-"]]
        if { $curOpt eq "verbose" } {
            set opts(Verbose) true
        } elseif { $curOpt eq "help" } {
            PrintUsage $argv0
            exit 1
        } elseif { $curOpt eq "nodelete" } {
            set opts(Delete) false
        } elseif { $curOpt eq "noauto" } {
            set opts(RunAuto) ""
        } elseif { $curOpt eq "notests" } {
            set opts(RunTests) false
        } elseif { $curOpt eq "nocover" } {
            set opts(RunCoverage) false
        } else {
            PrintUsage $argv0 "Invalid option \"$curParam\" specified."
            exit 1
        }
    }
    incr curArg
}

set tclExe [info nameofexecutable]

if { $opts(RunTests) } {
    foreach f [lsort -dictionary [glob -nocomplain ??_*.tcl]] {
        catch { file mkdir testOut }
        RunTest $f
        if { $opts(Delete) } {
            catch { file delete -force testOut }
        }
    }
    puts ""
}

if { $opts(RunCoverage) } {
    set pawtDir [file join [pwd] ".."]
    set auto_path [linsert $auto_path 0 $pawtDir [file join $pawtDir "Externals"]]

    package require pawt

    puts "Checking test coverage ..."

    set procList [list]
    set allProcList [lsort [info procs pawt::*]]
    foreach cmd $allProcList {
        if { ! [string match "*Obsolete:*" [info body $cmd]] } {
            if { [string first "::" $cmd] == 0 } {
                set cmd [string range $cmd 2 end]
            }
            lappend procList $cmd
        }
    }

    # We search the test scripts as well as the implementation files,
    # as a procedure may be used by a higher-level procedure and thus
    # does not have to be tested separately.
    set testFileList [lsort [glob "??_*.tcl" "../pawt*.tcl"]]

    foreach testFile $testFileList {
        if { $opts(Verbose) } {
            puts "Scanning testfile $testFile"
        }
        set fp [open $testFile "r"]
        while { [gets $fp line] >= 0 } {
            foreach cmd $procList {
                set ens [string map { "::" " " } $cmd]
                if { [string match "*${cmd}*" $line] || [string match "*${ens}*" $line] } {
                    #puts "Found proc $cmd in file $testFile"
                    set found($cmd) 1
                }
            }
        }
        close $fp
    }

    set foundList [lsort [array names found *]]
    foreach cmd $procList {
        if { [lsearch $foundList $cmd] < 0 } {
            puts "$cmd not yet tested"
        }
    }

    set numObsolete [expr [llength $allProcList] - [llength $procList]]
    puts "[llength $procList] procedures checked ($numObsolete obsolete)"
    puts ""
    unset found
}

exit 0
