mirror of
https://github.com/envmodules/modules.git
synced 2026-05-30 00:12:31 +08:00
e7b1985dde
Update mb script to skip several releases and be able to run bench or profiling on old and recent releases. Versions 4.1, 4.3, 4.5, 4.7 and 5.1 are retained for bench mode. 4.5, 4.7 and 5.1 are retained for profile mode.
301 lines
9.6 KiB
Tcl
Executable File
301 lines
9.6 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
#
|
|
# MB, make bench between modulecmd versions
|
|
# Copyright (C) 2019-2022 Xavier Delaruelle
|
|
#
|
|
# This program is free software: you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation, either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
##########################################################################
|
|
|
|
proc reportUsage {} {
|
|
puts "Usage: $::argv0 \[options\] \[bench|profile\] \[test...\]
|
|
|
|
Make bench between modulecmd versions
|
|
|
|
Available tests:
|
|
help, avail, avail2, avail3, whatis, whatis2, whatis3, apropos, load,
|
|
list, unload (all tests selected by default)
|
|
|
|
Modes:
|
|
bench Report command execution time
|
|
profile Report top 10 procedure calls
|
|
|
|
Options:
|
|
-h, --help Show this help message and exit
|
|
|
|
Examples:
|
|
$::argv0
|
|
$::argv0 profile
|
|
$::argv0 load unload list"
|
|
}
|
|
|
|
proc sgr {sgrcode str} {
|
|
return "\033\[${sgrcode}m$str\033\[0m"
|
|
}
|
|
|
|
proc reportError {str} {
|
|
puts "[sgr {1;31} ERROR]: $str"
|
|
}
|
|
|
|
set benchrep 20
|
|
set profprocnb 10
|
|
set curdir [pwd]
|
|
|
|
# time test run for a given modulecmd version
|
|
proc bench {tag args} {
|
|
return [expr {round([lindex [split [time {eval exec ./modulecmd.$tag sh\
|
|
$args >>& /dev/null} $::benchrep]] 0] / 1000)}]
|
|
}
|
|
|
|
# profile given modulecmd version test run
|
|
proc profile {tag args} {
|
|
return [eval exec script/mlprof report$::profprocnb $tag $args]
|
|
}
|
|
|
|
# run test for each modulecmd version
|
|
proc runtest {mode test} {
|
|
# set environment for test
|
|
if {[info exists ::testenvlist($test)]} {
|
|
foreach {var val} $::testenvlist($test) {
|
|
set ::env($var) $val
|
|
}
|
|
}
|
|
|
|
if {[info exists ::testsubcmdlist($test)]} {
|
|
lappend cmdlist $::testsubcmdlist($test)
|
|
} else {
|
|
lappend cmdlist $test
|
|
}
|
|
|
|
if {[info exists ::testarglist($test)]} {
|
|
set cmdlist [concat $cmdlist $::testarglist($test)]
|
|
}
|
|
|
|
foreach tag $::taglist {
|
|
# run test if tag version is compatible with it
|
|
if {[info exists ::testcompatlist($test)] && [string match {v[0-9]*}\
|
|
$tag] && "v$::testcompatlist($test)" ne $tag && [lindex [lsort\
|
|
-dictionary [list v$::testcompatlist($test) $tag]] 0] eq $tag} {
|
|
if {$mode eq {bench}} {
|
|
set res -
|
|
} else {
|
|
set res [list - 0 0]
|
|
for {set i 0} {$i < $::profprocnb} {incr i 1} {
|
|
lappend res - 0 0
|
|
}
|
|
}
|
|
} else {
|
|
set res [eval $mode $tag $cmdlist]
|
|
}
|
|
lappend ::testres($test) $tag $res
|
|
}
|
|
|
|
# clean test environment
|
|
if {[info exists ::testenvlist($test)]} {
|
|
foreach {var val} $::testenvlist($test) {
|
|
unset ::env($var)
|
|
}
|
|
}
|
|
}
|
|
|
|
# parse arguments
|
|
set hintmsg "\n Try '$argv0 --help' for more information."
|
|
foreach arg $argv {
|
|
switch -glob -- $arg {
|
|
profile {
|
|
set mode profile
|
|
}
|
|
bench {
|
|
set mode bench
|
|
}
|
|
help - avail - avail2 - avail3 - whatis - whatis2 - whatis3 - apropos -\
|
|
load - list - unload {
|
|
lappend testlist $arg
|
|
}
|
|
-h - --help {
|
|
reportUsage
|
|
exit 0
|
|
}
|
|
-* {
|
|
reportError "Invalid option '$arg'$hintmsg"
|
|
exit 1
|
|
}
|
|
default {
|
|
reportError "Invalid test name '$arg'$hintmsg"
|
|
exit 1
|
|
}
|
|
}
|
|
}
|
|
# use default values if not set on command-line
|
|
if {![info exists mode]} {
|
|
set mode bench
|
|
}
|
|
if {![info exists testlist]} {
|
|
set testlist [list help avail avail2 avail3 whatis whatis2 whatis3 apropos\
|
|
load list unload]
|
|
}
|
|
|
|
# fetch information from git repository to save workspace and get available
|
|
# modulecmd releases to compare. script will exit on first git command if it
|
|
# not called from a git repository
|
|
set headcommit [exec git rev-parse --short=8 HEAD]
|
|
array set headref_list [exec git show-ref --heads --abbrev=8]
|
|
set headref [expr {[info exists headref_list($headcommit)] ?\
|
|
[string range $headref_list($headcommit) 11 end] : $headcommit}]
|
|
|
|
set needstash [expr {[exec git status --porcelain --untracked-files=no] ne\
|
|
{}}]
|
|
|
|
# only keep last bugfix version of significant minor release
|
|
# drop releases older than 4.1 (or older than 4.5 if profile mode)
|
|
# drop several releases (to keep some old version in comparison)
|
|
# also drop alpha/beta releases
|
|
set exclvers_list [list v4.2 v4.4 v4.6 v4.8 v5.0]
|
|
set exclbef [expr {$mode eq {profile} ? {4.5} : {4.1}}]
|
|
array set tagarray [list]
|
|
foreach tag [exec git tag --list v*] {
|
|
if {[string compare $tag v$exclbef] == 1 && [string first alpha $tag] ==\
|
|
-1 && [string first beta $tag] == -1} {
|
|
set majmin [join [lrange [split $tag .] 0 1] .]
|
|
if {[lsearch -exact $exclvers_list $majmin] == -1 && (![info exists\
|
|
tagarray($majmin)] || [string compare $tag $tagarray($majmin)] ==\
|
|
1)} {
|
|
set tagarray($majmin) $tag
|
|
}
|
|
}
|
|
}
|
|
|
|
foreach tag [lsort [array names tagarray]] {
|
|
lappend taglist $tagarray($tag)
|
|
}
|
|
lappend taglist $headref
|
|
|
|
# save workspace
|
|
if {$needstash} {
|
|
exec git stash
|
|
}
|
|
|
|
# check what tag need to be built
|
|
foreach tag $taglist {
|
|
if {![file exists modulecmd.$tag]} {
|
|
lappend tagtobuildlist $tag
|
|
}
|
|
}
|
|
|
|
# build modulecmd and associated libtclenvmodules for each tag
|
|
if {[info exists tagtobuildlist]} {
|
|
# clean current workspace to build clean configuration
|
|
catch {file delete modulecmd-test.tcl modulecmd.tcl\
|
|
lib/libtclenvmodules.so}
|
|
|
|
foreach tag $tagtobuildlist {
|
|
exec git checkout $tag 2>@1
|
|
set buildtarget [expr {[string index $tag 0] ne {v} || [string\
|
|
compare $tag v4.3] == 1 ? {modulecmd-test.tcl} : {modulecmd.tcl}}]
|
|
exec make SHLIB_SUFFIX=.so.$tag $buildtarget
|
|
file rename $buildtarget modulecmd.$tag
|
|
file attributes modulecmd.$tag -permissions ugo+x
|
|
if {[file exists lib/envmodules.c]} {
|
|
exec make lib/libtclenvmodules.so
|
|
file rename lib/libtclenvmodules.so lib/libtclenvmodules.so.$tag
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
# configure environment for tests
|
|
catch {unset env(LOADEDMODULES)}
|
|
catch {unset env(LOADEDMODULES_modshare)}
|
|
catch {unset env(_LMFILES_)}
|
|
catch {unset env(_LMFILES__modshare)}
|
|
catch {unset env(MODULEPATH_modshare)}
|
|
catch {unset env(__MODULES_SHARE_MODULEPATH)}
|
|
|
|
# define bench tests and their arguments and environment
|
|
set modpath $curdir/testsuite/modulefiles
|
|
array set testsubcmdlist [list avail2 avail avail3 avail whatis2 whatis\
|
|
whatis3 whatis]
|
|
array set testarglist [list avail2 load whatis2 load load load/all unload\
|
|
load/all]
|
|
##nagelfar ignore Too long line
|
|
array set testenvlist [list avail [list MODULEPATH $modpath.deep:$modpath.deps] load [list MODULEPATH $modpath] list [list MODULEPATH $modpath LOADEDMODULES load/10:load/11:load/12:load/13:load/14:load/15:load/16:load/17:load/18:load/19:load/20:load/21:load/22:load/23:load/24:load/25:load/26:load/27:load/28:load/29:load/30:load/all _LMFILES_ $modpath/load/10:$modpath/load/11:$modpath/load/12:$modpath/load/13:$modpath/load/14:$modpath/load/15:$modpath/load/16:$modpath/load/17:$modpath/load/18:$modpath/load/19:$modpath/load/20:$modpath/load/21:$modpath/load/22:$modpath/load/23:$modpath/load/24:$modpath/load/25:$modpath/load/26:$modpath/load/27:$modpath/load/28:$modpath/load/29:$modpath/load/30:$modpath/load/all __MODULES_LMALTNAME load/all&load/default&load]]
|
|
set testenvlist(avail2) $testenvlist(avail)
|
|
set testenvlist(avail3) [list MODULEPATH $modpath.2 MODULERCFILE\
|
|
$curdir/testsuite/etc/modulerc.bench3 MODULES_ADVANCED_VERSION_SPEC 1\
|
|
MODULES_EXTENDED_DEFAULT 1]
|
|
set testenvlist(whatis) $testenvlist(avail)
|
|
set testenvlist(whatis2) $testenvlist(avail)
|
|
set testenvlist(whatis3) $testenvlist(avail3)
|
|
set testenvlist(apropos) $testenvlist(avail)
|
|
set testenvlist(unload) $testenvlist(list)
|
|
# some tests have a minimum version requirement
|
|
array set testcompatlist [list avail3 4.6.0 whatis3 4.6.0]
|
|
|
|
# adapt output table to test mode
|
|
if {$mode eq {profile}} {
|
|
set collen 45
|
|
set colsep {----------------------------------------------+}
|
|
} else {
|
|
set collen 9
|
|
set colsep {----------+}
|
|
}
|
|
set linesep ----------+[string repeat $colsep [llength $taglist]]
|
|
|
|
# output header
|
|
append tooutput [format "%9s |" {}]
|
|
foreach elt $taglist {
|
|
append tooutput [format "%${collen}s |" [string range $elt 0 7]]
|
|
}
|
|
append tooutput \n$linesep
|
|
puts $tooutput
|
|
|
|
# run each bench and output result
|
|
foreach test $testlist {
|
|
runtest $mode $test
|
|
if {$mode eq {profile}} {
|
|
set tooutput {}
|
|
set nbprofres [expr {$profprocnb + 1}]
|
|
for {set i 0} {$i < $nbprofres} {incr i 1} {
|
|
append tooutput [format "%9s |" [expr {$i == 0 ? $test : {}}]]
|
|
foreach {tag res} $::testres($test) {
|
|
set procname [lindex $res [expr {$i * 3}]]
|
|
set nbcalls [lindex $res [expr {$i * 3 + 1}]]
|
|
set runtime [lindex $res [expr {$i * 3 + 2}]]
|
|
append tooutput [format "%29s: %6d %7d |" $procname $nbcalls\
|
|
$runtime]
|
|
}
|
|
append tooutput \n
|
|
}
|
|
append tooutput $linesep
|
|
} else {
|
|
set tooutput [format "%9s |" $test]
|
|
foreach {tag res} $::testres($test) {
|
|
append tooutput [format "%${collen}s |" $res]
|
|
}
|
|
}
|
|
puts $tooutput
|
|
}
|
|
|
|
# clean built files
|
|
foreach tag $taglist {
|
|
catch {file delete modulecmd.$tag lib/libtclenvmodules.so.$tag}
|
|
}
|
|
|
|
# restore workspace if saved
|
|
if {$needstash} {
|
|
exec git stash pop
|
|
}
|
|
|
|
# vim:set tabstop=3 shiftwidth=3 expandtab autoindent syntax=tcl:
|