mumps: new test suite
This commit is contained in:
Oleg A. Khlybov
committed by
Christoph Reiter
Christoph Reiter
parent
022eb158cb
commit
f25ca078a8
@@ -30,7 +30,7 @@ _realname=mumps
|
||||
pkgbase=mingw-w64-${_realname}
|
||||
pkgname="${MINGW_PACKAGE_PREFIX}-${_realname}"
|
||||
pkgver=5.7.3
|
||||
pkgrel=1
|
||||
pkgrel=2
|
||||
pkgdesc="Sparse direct SLAE solver (mingw-w64)"
|
||||
arch=('any')
|
||||
mingw_arch=('mingw64' 'ucrt64')
|
||||
@@ -52,16 +52,18 @@ source=("https://mumps-solver.org/MUMPS_${pkgver}.tar.gz"
|
||||
"0001-makefile.inc.patch"
|
||||
"0002-skip-examples.patch"
|
||||
"0003-fix-setenv.patch"
|
||||
"all.tcl"
|
||||
"tclbuildtest.tcl"
|
||||
"mumps.test")
|
||||
"mumps.tcl"
|
||||
"testme-0.tm"
|
||||
"buildme-0.tm"
|
||||
"xyz-0.tm")
|
||||
sha256sums=('84a47f7c4231b9efdf4d4f631a2cae2bdd9adeaabc088261d15af040143ed112'
|
||||
'd4e3d06c316544304ac6fefd595f20fd5865e791c9377e031fbad49b6238406c'
|
||||
'bbefd4a5f841536132f32c1ffc684a58b778901cd777445ca817dbb34d983450'
|
||||
'11609d173fc0df7b1d7269c19d5d81b2fd05a3abc57eff8ba12de1597242236c'
|
||||
'ec5072630e1c0309fe383669e9187790cd135a393c67bc4bc35cf60b0ba396ff'
|
||||
'277a71049b2d4cde76ca21253b253ccd7ea9e8bcfb654868c05c6bfb137d2690'
|
||||
'58bc4cc4820cc91dc8cc67c2c95774b00c628fa56cc9c627894a5da08900b11b')
|
||||
'aa8cc50e447eebb14492744c8be6bd8f731e0140c339a76cc31e54ea2f11813d'
|
||||
'8d8f5670ffdf34a10b0d027bff976131824e2e6b053f8a13d207ecddd4663d6d'
|
||||
'd0db2aa573c9aaf57b30cb3c2bd7c66e1677f3f468002f467da98b75943076b1'
|
||||
'd52709e3663d50ed793bfe991c571ec4ea5e6eaf72fcc920e1f8ba43d0ed7050')
|
||||
|
||||
apply_patch_with_msg() {
|
||||
for _patch in "$@"
|
||||
@@ -131,7 +133,7 @@ package() {
|
||||
install -m644 *.h "${pkgdir}${MINGW_PREFIX}/include"
|
||||
)
|
||||
(
|
||||
cp ${srcdir}/{all.tcl,tclbuildtest.tcl,mumps.test} ${pkgdir}${MINGW_PREFIX}/share/test/mumps
|
||||
cp ${srcdir}/{*.tcl,*.tm} ${pkgdir}${MINGW_PREFIX}/share/test/mumps
|
||||
cd "$srcdir/${_realname}_${pkgver}/examples"
|
||||
cp c_example.c ?simpletest.F input_simpletest_* ${pkgdir}${MINGW_PREFIX}/share/test/mumps
|
||||
)
|
||||
|
||||
@@ -1,7 +0,0 @@
|
||||
# Template {all.tcl} file which is to be put into each test module's directory.
|
||||
# Either [source] the bundled {tclbuildtest.tcl} to force load the specific code or
|
||||
# alter the $auto_path list to add location of {pkgIndex.tcl,tclbuildtest.tcl}.
|
||||
# The same scheme is to be applied to all .test files.
|
||||
source [file join [file dirname [file normalize [info script]]] tclbuildtest.tcl]
|
||||
package require tclbuildtest
|
||||
::tclbuildtest::suite {*}$::argv
|
||||
70
mingw-w64-mumps/buildme-0.tm
Normal file
70
mingw-w64-mumps/buildme-0.tm
Normal file
@@ -0,0 +1,70 @@
|
||||
# https://github.com/okhlybov/testme
|
||||
|
||||
|
||||
package require Tcl
|
||||
|
||||
|
||||
namespace eval ::buildme {
|
||||
|
||||
|
||||
namespace export sandbox shell
|
||||
|
||||
|
||||
proc MakeTempDir {args} {
|
||||
upvar 1 unit unit
|
||||
set roots $args
|
||||
foreach t {TMPDIR TMP} {
|
||||
if {![catch {set t [set ::env($t)]}]} {
|
||||
lappend roots $t
|
||||
}
|
||||
}
|
||||
lappend roots /tmp
|
||||
foreach r $roots {
|
||||
if {![catch {
|
||||
set prefix [file rootname [file tail [dict get $unit -source]]]
|
||||
set t [file join $r $prefix.[expr {int(rand()*999999)}]]
|
||||
file mkdir $t
|
||||
}]} {return $t}
|
||||
}
|
||||
error "failed to create temporary directory $t"
|
||||
}
|
||||
|
||||
|
||||
proc sandbox {code} {
|
||||
upvar 1 unit unit
|
||||
set dir [MakeTempDir]
|
||||
try {
|
||||
foreach p [glob -nocomplain -directory [dict get $unit -stage] * .*] {
|
||||
set last [lindex [file split $p] end]
|
||||
if {$last != "." && $last != ".."} {
|
||||
file copy -force -- $p $dir
|
||||
}
|
||||
}
|
||||
# Can't cd into stage dir in multithreaded environment where all threads have the same current directory
|
||||
dict set unit -stage $dir
|
||||
eval $code
|
||||
} finally {
|
||||
if {[dict get $unit -cleanup]} {
|
||||
if {[catch {file delete -force -- $dir}]} {
|
||||
puts stderr "failed to delete temporary directory $dir
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc shell {cmd} {
|
||||
upvar 1 unit unit
|
||||
set stage [dict get $unit -stage]
|
||||
set cd "cd \"$stage\""
|
||||
puts stdout "$cd && \\\n$cmd"
|
||||
if {[catch {exec -ignorestderr $::env(SHELL) -c "$cd && $cmd" 2>@1} result opts]} {
|
||||
puts stderr $result
|
||||
} else {
|
||||
puts stdout $result
|
||||
}
|
||||
return {*}$opts $result
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
48
mingw-w64-mumps/mumps.tcl
Normal file
48
mingw-w64-mumps/mumps.tcl
Normal file
@@ -0,0 +1,48 @@
|
||||
tcl::tm::add [file normalize [file join [file dirname [info script]] .]]
|
||||
|
||||
|
||||
package require xyz
|
||||
|
||||
|
||||
foreach static {{} static} {
|
||||
foreach executor {{} omp} {
|
||||
xyz::unit MUMPS [concat $executor $static c double] {
|
||||
package require buildme
|
||||
buildme::sandbox {
|
||||
buildme::shell "cc -o a c_example.c `pkgconf mumps-[dict get $unit -xyz] --cflags --libs [dict get $unit -static]` [dict get $unit -static] && ./a"
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach executor {mpi} {
|
||||
xyz::unit MUMPS [concat $executor $static c double] {
|
||||
package require buildme
|
||||
buildme::sandbox {
|
||||
buildme::shell "mpicc -o a c_example.c `pkgconf mumps-[dict get $unit -xyz] --cflags --libs [dict get $unit -static]` [dict get $unit -static] && mpiexec -n 1 ./a"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach precision {double single} {
|
||||
foreach scalar {real complex} {
|
||||
if {$scalar == "complex"} {set input input_simpletest_cmplx} else {set input input_simpletest_real}
|
||||
foreach static {{} static} {
|
||||
foreach executor {{} omp} {
|
||||
xyz::unit MUMPS [list $executor $static $precision $scalar fortran] -input $input {
|
||||
package require buildme
|
||||
buildme::sandbox {
|
||||
buildme::shell "gfortran -o a [string index [dict get $unit -xyz] 0]simpletest.F -I/ucrt64/include `pkgconf mumps-[dict get $unit -xyz] --cflags --libs [dict get $unit -static]` [dict get $unit -static] && ./a < [dict get $unit -input]"
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach executor {mpi} {
|
||||
xyz::unit MUMPS [list $executor $static $precision $scalar fortran] -input $input {
|
||||
package require buildme
|
||||
buildme::sandbox {
|
||||
buildme::shell "mpifort -o a [string index [dict get $unit -xyz] 0]simpletest.F -I/usrt64/include `pkgconf mumps-[dict get $unit -xyz] --cflags --libs [dict get $unit -static]` [dict get $unit -static] && mpiexec -n 1 ./a < [dict get $unit -input]"
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,21 +0,0 @@
|
||||
source [file join [file dirname [file normalize [info script]]] tclbuildtest.tcl]
|
||||
|
||||
package require tclbuildtest
|
||||
|
||||
::tclbuildtest::sandbox {
|
||||
foreach t {{} openmp mpi} {
|
||||
foreach b {{} static} {
|
||||
test [list c $t real double $b] {
|
||||
run [build [require mumps-[xyz]] c_example.c]
|
||||
}
|
||||
foreach s {real complex} {
|
||||
foreach p {single double} {
|
||||
test [list fortran $t $p $s $b] {
|
||||
if {[constraint? complex]} {set input input_simpletest_cmplx} else {set input input_simpletest_real}
|
||||
run [build [require mumps-[xyz]] -fallow-invalid-boz [x]simpletest.F] < $input
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -1,751 +0,0 @@
|
||||
#
|
||||
# TclTest extenstion to test source code compilation & running
|
||||
#
|
||||
# https://github.com/okhlybov/tclbuildtest
|
||||
#
|
||||
|
||||
package provide tclbuildtest 0.1.0
|
||||
|
||||
package require Tcl 8.6
|
||||
package require tcltest 2.5.1
|
||||
|
||||
namespace eval ::tcltest {}; # Make pkg_mkIndex happy
|
||||
|
||||
# https://github.com/tcl2020/named-parameters
|
||||
|
||||
namespace eval ::np {
|
||||
#
|
||||
# proc_args_to_dict - given a proc name and declared
|
||||
# proc arguments (variable names with optional
|
||||
# default values and a -- and possible some more
|
||||
# stuff, create and return a dict containing that
|
||||
# info in a way that's convenient and quicker
|
||||
# for us at runtime:
|
||||
# * we store a list of positional parameters
|
||||
# * we store a list of named parameters
|
||||
# * we store a list of var-value defaults
|
||||
# * we get a tricked-out error message in errmsg
|
||||
#
|
||||
::proc proc_args_to_dict {name procArgs} {
|
||||
set seenDashes 0
|
||||
dict set d defaults [list]
|
||||
dict set d positional [list]
|
||||
dict set d named [list]
|
||||
set errmsg "wrong # args: should be \"$name "
|
||||
|
||||
foreach arg $procArgs {
|
||||
if {$arg eq "--"} {
|
||||
set seenDashes 1
|
||||
append errmsg "?--? "
|
||||
continue
|
||||
}
|
||||
|
||||
set var [lindex $arg 0]
|
||||
dict lappend d [expr {$seenDashes ? "positional" : "named"}] $var
|
||||
|
||||
if {[llength $arg] == 2} {
|
||||
dict lappend d defaults $var [lindex $arg 1]
|
||||
if {$seenDashes} {
|
||||
append errmsg "?$var? "
|
||||
} else {
|
||||
append errmsg "?-$var val? "
|
||||
}
|
||||
} elseif {$var eq "args"} {
|
||||
dict lappend d defaults $var [list]
|
||||
append errmsg "?arg ...? "
|
||||
} else {
|
||||
if {$seenDashes} {
|
||||
append errmsg "$var "
|
||||
} else {
|
||||
append errmsg "-$var val "
|
||||
}
|
||||
}
|
||||
}
|
||||
dict set d errmsg "[string range $errmsg 0 end-1]\""
|
||||
return $d
|
||||
}
|
||||
|
||||
#
|
||||
# np_handler - look at an argument dict created by proc_args_to_dict
|
||||
# and look at the real arguments to a function (args), and sort
|
||||
# out the named and positional parameters to behave in the
|
||||
# expected way.
|
||||
#
|
||||
::proc np_handler {argd realArgs} {
|
||||
set named [dict get $argd named]
|
||||
set positional [dict get $argd positional]
|
||||
|
||||
# process named parameters
|
||||
while {[llength $realArgs] > 0} {
|
||||
set arg [lindex $realArgs 0]
|
||||
|
||||
# if arg is --, flip to positional
|
||||
if {$arg eq "--"} {
|
||||
set realArgs [lrange $realArgs 1 end]
|
||||
break
|
||||
}
|
||||
|
||||
# if "var" doesn't start with a dash, flip to positional
|
||||
if {[string index $arg 0] ne "-"} {
|
||||
#puts "possible var '$arg' doesn't start with a dash, flip to positional"
|
||||
break
|
||||
}
|
||||
|
||||
# if "var" isn't known to us as a named parameter, flip to positional
|
||||
set var [string range $arg 1 end]
|
||||
if {[lsearch $named $var] < 0} {
|
||||
#puts "'var' '$arg' not recognized, flip to positional"
|
||||
break
|
||||
}
|
||||
|
||||
# if there isn't at least one more element in the arg list,
|
||||
# we are missing a value for one of our named parameters
|
||||
if {[llength $realArgs] == 0} {
|
||||
#puts "realArgs is empty but i expect something for $var"
|
||||
error [dict get $argd errmsg] "" [list TCL WRONGARGS]
|
||||
}
|
||||
|
||||
# we're good, set the named parameter into the variable sets
|
||||
#puts [list set vsets($var) [lindex $realArgs 1]]
|
||||
|
||||
# but don't allow the same variable to be set twice
|
||||
if {[info exists vsets($var)]} {
|
||||
error [dict get $argd errmsg] "" [list TCL WRONGARGS]
|
||||
}
|
||||
|
||||
set vsets($var) [lindex $realArgs 1]
|
||||
set realArgs [lrange $realArgs 2 end]
|
||||
}
|
||||
|
||||
# fill in defaults for all the vars with defaults that
|
||||
# didn't get set to a value
|
||||
foreach "var value" [dict get $argd defaults] {
|
||||
if {![info exists vsets($var)]} {
|
||||
set vsets($var) $value
|
||||
}
|
||||
}
|
||||
|
||||
foreach var $positional {
|
||||
if {$var eq "args"} {
|
||||
set vsets($var) $realArgs
|
||||
set realArgs [list]
|
||||
break
|
||||
}
|
||||
|
||||
if {[llength $realArgs] > 0} {
|
||||
set vsets($var) [lindex $realArgs 0]
|
||||
set realArgs [lrange $realArgs 1 end]
|
||||
}
|
||||
|
||||
# no arguments left. if this var doesn't
|
||||
# have a default value, it's a wrong args error
|
||||
if {![info exists vsets($var)]} {
|
||||
error [dict get $argd errmsg] "" [list TCL WRONGARGS]
|
||||
}
|
||||
}
|
||||
|
||||
# make sure all the named parameters have been set, either
|
||||
# by defaults or explicitly, any not set is an error
|
||||
foreach var $named {
|
||||
if {![info exists vsets($var)]} {
|
||||
#puts "required named parameter '-$var' is not set"
|
||||
error [dict get $argd errmsg] "" [list TCL WRONGARGS]
|
||||
}
|
||||
}
|
||||
|
||||
# are there too many arguments?
|
||||
if {[llength $realArgs] > 0} {
|
||||
#puts "leftover arguments (too many) '$realArgs'"
|
||||
error [dict get $argd errmsg] "" [list TCL WRONGARGS]
|
||||
}
|
||||
|
||||
# now iterate through the var-value pairs and set them into
|
||||
# the caller's frame
|
||||
foreach "var value" [array get vsets] {
|
||||
#puts "set '$var' '$value'"
|
||||
upvar $var myvar
|
||||
set myvar $value
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
#
|
||||
# np::proc - same as proc except if -- is in the argv
|
||||
# then it will generate a proc that has extra code
|
||||
# at the beginning to wrangle the named parameters
|
||||
#
|
||||
proc proc {name argv body} {
|
||||
# handle the case where there are no named parameters
|
||||
if {[lsearch $argv --] < 0} {
|
||||
uplevel [list ::proc $name $argv $body]
|
||||
return
|
||||
}
|
||||
|
||||
if {[lsearch $argv --] == 0} {
|
||||
return -code error "-- cannot be the first argument for named parameters. Use positional parameters."
|
||||
}
|
||||
|
||||
set d [proc_args_to_dict $name $argv]
|
||||
set newbody "::proc $name args {\n"
|
||||
append newbody " ::np::np_handler [list $d] \$args\n"
|
||||
append newbody $body
|
||||
append newbody "\n}"
|
||||
#puts $newbody
|
||||
uplevel $newbody
|
||||
}
|
||||
}
|
||||
|
||||
namespace eval ::tclbuildtest {
|
||||
|
||||
variable system-count 0
|
||||
variable build-count 0
|
||||
|
||||
# Standard predefined constraints
|
||||
foreach ct {
|
||||
c cxx fortran
|
||||
single double
|
||||
real complex
|
||||
openmp thread hybrid mpi
|
||||
static
|
||||
debug
|
||||
} {::tcltest::testConstraint $ct 1}
|
||||
|
||||
# Return a value of the environment variable or {} if no such variable is set
|
||||
proc env {var} {
|
||||
try {return [set ::env($var)]} on error {} {return {}}
|
||||
}
|
||||
|
||||
# MpiExec detection
|
||||
proc mpiexec {} {
|
||||
variable mpiexec
|
||||
try {set mpiexec} on error {} {
|
||||
set mpiexec {}
|
||||
foreach x [collect [env MPIEXEC] mpiexec mpirun] {
|
||||
if {![catch {exec {*}$x}]} {
|
||||
set mpiexec $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$mpiexec == {}} {error {failed to detect MpiExec or equivalent}}
|
||||
return $mpiexec
|
||||
}
|
||||
|
||||
# PkgConfig detection
|
||||
proc pkg-config {} {
|
||||
variable pc
|
||||
try {set pc} on error {} {
|
||||
set pc {}
|
||||
foreach x [collect [env PKG_CONFIG] pkg-config pkgconf] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set pc $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$pc == {}} {error {failed to detect PkgConfig or equivalent}}
|
||||
return $pc
|
||||
}
|
||||
|
||||
# C compiler detection
|
||||
proc cc {} {
|
||||
variable cc
|
||||
try {set cc} on error {} {
|
||||
set cc {}
|
||||
foreach x [collect [env CC] gcc] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set cc $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$cc == {}} {error {failed to detect C compiler}}
|
||||
return $cc
|
||||
}
|
||||
|
||||
# C++ compiler detection
|
||||
proc cxx {} {
|
||||
variable cxx
|
||||
try {set cxx} on error {} {
|
||||
set cxx {}
|
||||
foreach x [collect [env CXX] g++] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set cxx $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$cxx == {}} {error {failed to detect C++ compiler}}
|
||||
return $cxx
|
||||
}
|
||||
|
||||
# FORTRAN compiler detection
|
||||
proc fc {} {
|
||||
variable fc
|
||||
try {set fc} on error {} {
|
||||
set fc {}
|
||||
foreach x [collect [env FC] gfortran] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set fc $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$fc == {}} {error {failed to detect FORTRAN compiler}}
|
||||
return $fc
|
||||
}
|
||||
|
||||
# MPI C compiler detection
|
||||
proc mpicc {} {
|
||||
variable mpicc
|
||||
try {set mpicc} on error {} {
|
||||
set mpicc {}
|
||||
foreach x [collect [env MPICC] mpicc] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set mpicc $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$mpicc == {}} {error {failed to detect MPI C compiler}}
|
||||
return $mpicc
|
||||
}
|
||||
|
||||
# MPI C++ compiler detection
|
||||
proc mpicxx {} {
|
||||
variable mpicxx
|
||||
try {set mpicxx} on error {} {
|
||||
set mpicxx {}
|
||||
foreach x [collect [env MPICXX] mpicxx mpic++] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set mpicxx $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$mpicxx == {}} {error {failed to detect MPI C++ compiler}}
|
||||
return $mpicxx
|
||||
}
|
||||
|
||||
# MPI FORTRAN compiler detection
|
||||
proc mpifc {} {
|
||||
variable mpifc
|
||||
try {set mpifc} on error {} {
|
||||
set mpifc {}
|
||||
foreach x [collect [env MPIFC] [env MPIFORT] mpifort mpif90 mpif77] {
|
||||
if {![catch {exec {*}$x --version}]} {
|
||||
set mpifc $x
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$mpifc == {}} {error {failed to detect MPI FORTRAN compiler}}
|
||||
return $mpifc
|
||||
}
|
||||
|
||||
# Create temporary directory
|
||||
proc mktempdir {} {
|
||||
set t [file join $::env(TEMP) [file rootname [file tail [info script]]][expr {int(rand()*9999)}]]
|
||||
file mkdir $t
|
||||
return $t
|
||||
}
|
||||
|
||||
# Delete directory tree
|
||||
proc rmdir {dir} {
|
||||
try {
|
||||
file delete -force $dir
|
||||
} on error {} {
|
||||
# This command fires up a background sanitizing process which does its best to delete
|
||||
# staging directory in spite of executable locks or what's not which can happend on Windows
|
||||
# This code should work in real UNIX environments or UNIX-like Windows environments
|
||||
# such as Cygwin or MSYS(2).
|
||||
exec -ignorestderr sh -c "nohup \${SHELL} -c \" while \[ -d '$dir' \]; do rm -rf '$dir' || sleep 3; done\" > /dev/null 2>&1 &"
|
||||
}
|
||||
}
|
||||
|
||||
# Execute script from a temporary location
|
||||
# Script file is copied to the location along with all residing files
|
||||
# The location gets deleted afterwards
|
||||
proc sandbox {script} {
|
||||
variable stagedir [mktempdir]
|
||||
try {
|
||||
::tcltest::configure {*}$::argv
|
||||
::tcltest::workingDirectory $stagedir
|
||||
file copy -force {*}[glob -directory [file dirname [file normalize [info script]]] -nocomplain *] $stagedir
|
||||
eval $script
|
||||
} finally {
|
||||
::tcltest::cleanupTests
|
||||
rmdir $stagedir
|
||||
}
|
||||
}
|
||||
|
||||
# Obtain compilation and linking flags for the specified packages via PkgConfig
|
||||
proc require {args} {
|
||||
if {[constraint? static]} {set flags --static} else {set flags {}}
|
||||
xflags {*}[lindex [dict get [system [pkg-config] {*}$args --keep-system-cflags --cflags {*}$flags] stdout] 0]
|
||||
ldflags {*}[lindex [dict get [system [pkg-config] {*}$args --libs {*}$flags] stdout] 0]
|
||||
return
|
||||
}
|
||||
|
||||
# Deduce source code language from command line arguments
|
||||
proc deduce-language {opts} {
|
||||
switch -regexp -nocase [lindex $opts [lsearch -glob -not $opts {-*}]] {
|
||||
{\.c$} {return c}
|
||||
{\.(cxx|cpp|cc)$} {return cxx}
|
||||
{\.(f|for|f\d+)$} {return fortran}
|
||||
default {error {failed to deduce source language from the command line agruments}}
|
||||
}
|
||||
}
|
||||
|
||||
# Deduce compilation command from command line arguments
|
||||
proc deduce-compiler-proc {opts} {
|
||||
set lang [deduce-language $opts]
|
||||
if {[constraint? mpi]} {
|
||||
switch $lang {
|
||||
c {return mpicc}
|
||||
cxx {return mpicxx}
|
||||
fortran {return mpifc}
|
||||
}
|
||||
} else {
|
||||
switch $lang {
|
||||
c {return cc}
|
||||
cxx {return cxx}
|
||||
fortran {return fc}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Deduce compilation flags command from command line arguments
|
||||
proc deduce-compile-flags-proc {opts} {
|
||||
switch [deduce-language $opts] {
|
||||
c {return cflags}
|
||||
cxx {return cxxflags}
|
||||
fortran {return fflags}
|
||||
}
|
||||
}
|
||||
|
||||
# C preprocessor command line arguments
|
||||
proc cppflags {args} {
|
||||
variable cppflags
|
||||
try {set cppflags} on error {} {
|
||||
set cppflags [lsqueeze [env CPPFLAGS]]
|
||||
if {![constraint? debug]} {lappend cppflags -DNDEBUG}
|
||||
}
|
||||
lappend cppflags {*}$args
|
||||
}
|
||||
|
||||
# Language-agnostic compilation command line arguments
|
||||
proc xflags {args} {
|
||||
variable xflags
|
||||
try {set xflags} on error {} {
|
||||
set xflags {}
|
||||
if {[constraint? openmp]} {lappend xflags -fopenmp}
|
||||
if {[constraint? thread]} {lappend xflags -pthread}
|
||||
if {[constraint? debug]} {lappend xflags -Og} else {lappend xflags -O2}
|
||||
}
|
||||
lappend xflags {*}$args
|
||||
}
|
||||
|
||||
# C-specific compilation command line arguments
|
||||
proc cflags {args} {
|
||||
variable cflags
|
||||
try {set cflags} on error {} {
|
||||
set cflags [lsqueeze [env CFLAGS]]
|
||||
}
|
||||
lappend cflags {*}$args
|
||||
}
|
||||
|
||||
|
||||
# C++-specific compilation command line arguments
|
||||
proc cxxflags {args} {
|
||||
variable cxxflags
|
||||
try {set cxxflags} on error {} {
|
||||
set cxxflags [lsqueeze [env CXXFLAGS]]
|
||||
}
|
||||
lappend cxxflags {*}$args
|
||||
}
|
||||
|
||||
# FORTRAN-specific compilation command line arguments
|
||||
proc fflags {args} {
|
||||
variable fflags
|
||||
try {set fflags} on error {} {
|
||||
set fflags [lsqueeze [env FFLAGS]]
|
||||
}
|
||||
lappend fflags {*}$args
|
||||
}
|
||||
|
||||
# Linker command line arguments
|
||||
proc ldflags {args} {
|
||||
variable ldflags
|
||||
try {set ldflags} on error {} {
|
||||
set ldflags [lsqueeze [env LDFLAGS]]
|
||||
if {[constraint? static]} {lappend ldflags -static}
|
||||
if {[constraint? openmp]} {lappend ldflags -fopenmp}
|
||||
if {[constraint? thread]} {lappend ldflags -pthread}
|
||||
}
|
||||
lappend ldflags {*}$args
|
||||
}
|
||||
|
||||
# Linked libraries command line arguments
|
||||
proc libs {args} {
|
||||
variable libs
|
||||
try {set libs} on error {} {
|
||||
set libs [lsqueeze [env LIBS]]
|
||||
if {[constraint? cxx]} {lappend libs -lstdc++}
|
||||
if {[constraint? fortran]} {lappend libs -lgfortran -lquadmath}
|
||||
}
|
||||
lappend libs {*}$args
|
||||
}
|
||||
|
||||
# Perform source code compilation into executable
|
||||
# Returns the executable name
|
||||
proc build {args} {
|
||||
set args [lsqueeze $args]
|
||||
set exe [executable]
|
||||
system {*}[concat \
|
||||
[[deduce-compiler-proc $args]] \
|
||||
-o $exe \
|
||||
[cppflags] \
|
||||
[xflags] \
|
||||
[[deduce-compile-flags-proc $args]] \
|
||||
$args \
|
||||
[ldflags] \
|
||||
[libs] \
|
||||
]
|
||||
return $exe
|
||||
}
|
||||
|
||||
# Perform running of the specified executable with supplied command line arguments
|
||||
proc run {args} {
|
||||
if {[constraint? mpi]} {set runner [mpiexec]} else {set runner {}}
|
||||
system {*}[list $runner {*}$args]
|
||||
}
|
||||
|
||||
# Execute command line built from command line arguments
|
||||
proc system {args} {
|
||||
variable system-count
|
||||
incr system-count
|
||||
set stdout stdout${system-count}
|
||||
set stderr stderr${system-count}
|
||||
set args [lsqueeze $args]
|
||||
set command [join $args]
|
||||
if {[lsearch [::tcltest::verbose] exec] < 0} {set verbose 0} else {set verbose 1}
|
||||
if {$verbose} {::puts [::tcltest::outputChannel] "> $command"}
|
||||
try {
|
||||
exec -ignorestderr -- {*}$args > $stdout 2> $stderr
|
||||
set options {}
|
||||
set status 0
|
||||
set code ok
|
||||
} trap CHILDSTATUS {results options} {
|
||||
set status [lindex [dict get $options -errorcode] 2]
|
||||
set code error
|
||||
} finally {
|
||||
try {
|
||||
set out [read-file $stdout]
|
||||
set err [read-file $stderr]
|
||||
} finally {
|
||||
file delete -force $stdout $stderr
|
||||
}
|
||||
}
|
||||
if {$verbose} {
|
||||
foreach x $out {::puts [::tcltest::outputChannel] $x}
|
||||
if {[llength $out] > 0 && [llength $err] > 0} {::puts [::tcltest::outputChannel] ----}
|
||||
foreach x $err {::puts [::tcltest::outputChannel] $x}
|
||||
}
|
||||
return -code $code [dict create command $command status $status stdout $out stderr $err options $options]
|
||||
}
|
||||
|
||||
# Construct a scalar type ID from the constraints
|
||||
proc x {} {
|
||||
if {[constraint? complex]} {
|
||||
if {[constraint? double]} {return z}
|
||||
if {[constraint? single]} {return c}
|
||||
} else {
|
||||
if {[constraint? double]} {return d}
|
||||
if {[constraint? single]} {return s}
|
||||
}
|
||||
error {failed to contstruct the scalar type}
|
||||
}
|
||||
|
||||
# Construct an execution model ID from the constraints
|
||||
proc y {} {
|
||||
if {[constraint? mpi]} {return m}
|
||||
if {[constraint-any? openmp thread]} {return t}
|
||||
if {[constraint? hybrid]} {return h}
|
||||
return s
|
||||
}
|
||||
|
||||
# Construct an build type ID from the constraints
|
||||
proc z {} {
|
||||
if {[constraint? debug]} {return g}
|
||||
return o
|
||||
}
|
||||
|
||||
# Construct a 3-letter XYZ build code from the constraints
|
||||
proc xyz {} {
|
||||
return [x][y][z]
|
||||
}
|
||||
|
||||
# Construct the test name based on the constraints set
|
||||
proc name {} {
|
||||
join [list [file rootname [file tail [info script]]] {*}[constraints]] -
|
||||
}
|
||||
|
||||
# Construct new unique executable name
|
||||
proc executable {} {
|
||||
variable build-count
|
||||
variable executable
|
||||
return [set executable [name]-[incr build-count].exe]
|
||||
}
|
||||
|
||||
# Construct human-readable description of the test according to the contraints set
|
||||
proc description {} {
|
||||
set t {}
|
||||
switch [intersection {c cxx fortran} [constraints]] {
|
||||
c {lappend t C}
|
||||
cxx {lappend t C++}
|
||||
fortran {lappend t FORTRAN}
|
||||
}
|
||||
try {
|
||||
switch [y] {
|
||||
s {lappend t sequential}
|
||||
m {lappend t MPI}
|
||||
t {lappend t multithreaded}
|
||||
h {lappend t heterogeneous}
|
||||
}
|
||||
} on error {} {}
|
||||
try {
|
||||
switch [x] {
|
||||
s {lappend t "single precision"}
|
||||
d {lappend t "double precision"}
|
||||
c {lappend t "single precision complex"}
|
||||
z {lappend t "double precision complex"}
|
||||
}
|
||||
} on error {} {}
|
||||
switch [z] {
|
||||
o {lappend t optimized}
|
||||
g {lappend t debugging}
|
||||
}
|
||||
if {[constraint? static]} {lappend t static}
|
||||
join $t
|
||||
}
|
||||
|
||||
# Set constraints
|
||||
proc constraints {args} {
|
||||
variable constraints
|
||||
try {set constraints} on error {} {
|
||||
set constraints {}
|
||||
}
|
||||
lappend constraints {*}[lsqueeze $args]
|
||||
}
|
||||
|
||||
# Return true if any of specified contraints is set
|
||||
proc constraint-any? {args} {
|
||||
foreach ct $args {
|
||||
if {[constraint? $ct]} {return 1}
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
# Return true if all scpecified constraints are set
|
||||
proc constraint-all? {args} {
|
||||
foreach ct $args {
|
||||
if {![constraint? $ct]} {return 0}
|
||||
}
|
||||
return 1
|
||||
}
|
||||
|
||||
# Return true if specified constraint is set
|
||||
proc constraint? {ct} {
|
||||
variable constraints
|
||||
expr {[lsearch $constraints $ct] >= 0}
|
||||
}
|
||||
|
||||
# Test failure is triggered by throwing an exception
|
||||
::tcltest::customMatch exception {return 1; #}
|
||||
|
||||
# Main test command
|
||||
::np::proc test {{name {}} {description {}} {match {exception}} -- cts script} {
|
||||
foreach v {executable constraints cppflags xflags cflags cxxflags fflags ldflags libs} {variable $v; catch {unset $v}}
|
||||
set cts [constraints {*}$cts]
|
||||
if {$name == {}} {set name [name]}
|
||||
if {$description == {}} {set description "[description] build"}
|
||||
::tcltest::test $name $description -constraints $cts -body $script -match $match
|
||||
# Attempt to delete the created executable if any to conserve space in the stage dir
|
||||
# It's OK for the operation to fail at this point as the executable may still be locked
|
||||
variable executable; try {file delete -force $executable} on error {} {}
|
||||
}
|
||||
|
||||
# To be used in {all.tcl}
|
||||
proc suite {args} {
|
||||
::tcltest::configure -testdir [file dirname [file normalize [info script]]] {*}$args
|
||||
::tcltest::runAllTests
|
||||
::tcltest::cleanupTests
|
||||
}
|
||||
|
||||
# Quick & dirty hack to introduce extra verbosity option(s)
|
||||
# Override the proc from in tcltest-*.tm
|
||||
# Original code corresponds to version 2.5.1
|
||||
proc ::tcltest::AcceptVerbose { level } {
|
||||
set level [AcceptList $level]
|
||||
set levelMap {
|
||||
x exec
|
||||
l list
|
||||
p pass
|
||||
b body
|
||||
s skip
|
||||
t start
|
||||
e error
|
||||
l line
|
||||
m msec
|
||||
u usec
|
||||
}
|
||||
set levelRegexp "^([join [dict values $levelMap] |])\$"
|
||||
if {[llength $level] == 1} {
|
||||
if {![regexp $levelRegexp $level]} {
|
||||
# translate single characters abbreviations to expanded list
|
||||
set level [string map $levelMap [split $level {}]]
|
||||
}
|
||||
}
|
||||
set valid [list]
|
||||
foreach v $level {
|
||||
if {[regexp $levelRegexp $v]} {
|
||||
lappend valid $v
|
||||
}
|
||||
}
|
||||
return $valid
|
||||
}
|
||||
|
||||
# Read text file and return list of lines
|
||||
proc read-file {file} {
|
||||
set f [open $file r]
|
||||
try {
|
||||
return [split [read -nonewline $f] \n]
|
||||
} finally {
|
||||
close $f
|
||||
}
|
||||
}
|
||||
|
||||
# Return a new list from the specified list entries squashing {} values
|
||||
proc lsqueeze {list} {
|
||||
set out [list]
|
||||
foreach x $list {
|
||||
if {$x != {}} {lappend out $x}
|
||||
}
|
||||
return $out
|
||||
}
|
||||
|
||||
# Return a new list from the specified arguments squashing {} values
|
||||
proc collect {args} {
|
||||
lsqueeze $args
|
||||
}
|
||||
|
||||
# Return intersection of two lists
|
||||
proc intersection {a b} {
|
||||
set x {}
|
||||
foreach i $a {
|
||||
if {[lsearch -exact $b $i] != -1} {lappend x $i}
|
||||
}
|
||||
return $x
|
||||
}
|
||||
}
|
||||
640
mingw-w64-mumps/testme-0.tm
Normal file
640
mingw-w64-mumps/testme-0.tm
Normal file
@@ -0,0 +1,640 @@
|
||||
# https://github.com/okhlybov/testme
|
||||
|
||||
|
||||
package require Tcl
|
||||
|
||||
|
||||
package require Thread
|
||||
|
||||
|
||||
namespace eval ::testme {
|
||||
|
||||
|
||||
namespace export unit
|
||||
|
||||
|
||||
proc Import {source} {
|
||||
variable executor
|
||||
interp create box
|
||||
try {
|
||||
interp alias box ::testme::unit {} ::testme::unit
|
||||
box eval set ::argv0 [file normalize $source]
|
||||
box eval set ::nesting [incr $::nesting -1]
|
||||
box eval {
|
||||
cd [file dirname $::argv0]
|
||||
source [file tail $::argv0]
|
||||
}
|
||||
} finally {
|
||||
interp delete box
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
### Toplevel code
|
||||
|
||||
|
||||
try {set ::nesting} on error {} {
|
||||
|
||||
|
||||
package require platform
|
||||
|
||||
|
||||
try {
|
||||
|
||||
|
||||
### CLIP code
|
||||
|
||||
|
||||
# package require Tcl 8.6
|
||||
|
||||
|
||||
namespace eval ::clip {
|
||||
|
||||
|
||||
# defs: { { opt(s) } -slot opt -default value -info "text" -section {common} -apply {script} }
|
||||
proc parse {argv defs} {
|
||||
set x [lsearch $argv --]
|
||||
if {$x < 0} {
|
||||
set opts $argv
|
||||
set args {}
|
||||
} else {
|
||||
set opts [lrange $argv 0 [expr {$x-1}]]
|
||||
set args [lrange $argv [expr {$x+1}] end]
|
||||
}
|
||||
set xargs {}
|
||||
lassign [NormalizeDefs $defs] short_flags short_opts long_flags long_opts
|
||||
set flagset [dict create]
|
||||
foreach f $short_flags {
|
||||
dict set flagset [dict get $f bare] $f
|
||||
}
|
||||
while {[llength $opts]} {
|
||||
set x [Next opts]
|
||||
# long option with inline value, ex. --abc=123
|
||||
if {[regexp {^-+([[:alnum:]][[:alnum:]\-\_]*)=(.*)$} $x ~ tag value]} {
|
||||
set found 0
|
||||
foreach d $long_opts {
|
||||
dict with d {
|
||||
if {$tag == $bare} {
|
||||
set found 1
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$found} {
|
||||
apply $apply $slot $value
|
||||
continue
|
||||
} else {
|
||||
error "unrecognized option in $x"
|
||||
}
|
||||
}
|
||||
# long/short option expecting separate value, ex. --abc 123
|
||||
if {[regexp {^-+([[:alnum:]][[:alnum:]\-\_]*)} $x ~ tag]} {
|
||||
set found 0
|
||||
foreach d [concat $long_opts $short_opts] {
|
||||
dict with d {
|
||||
if {$tag == $bare} {
|
||||
set value [Next opts]
|
||||
set found 1
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$found} {
|
||||
apply $apply $slot $value
|
||||
continue
|
||||
}
|
||||
}
|
||||
# long/short separate flag, ex. -C, --create
|
||||
if {[regexp {^-+([[:alnum:]][[:alnum:]\-\_]*)} $x ~ tag]} {
|
||||
set found 0
|
||||
foreach d [concat $long_flags $short_flags] {
|
||||
dict with d {
|
||||
if {$tag == $bare} {
|
||||
set value $default
|
||||
set found 1
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$found} {
|
||||
apply $apply $slot $value
|
||||
continue
|
||||
}
|
||||
}
|
||||
# short flag within the coalesced flag set, ex. -Sxy
|
||||
if {[regexp {^-([[:alnum:]]+)$} $x ~ flags]} {
|
||||
foreach flag [split $flags {}] {
|
||||
try {
|
||||
set d [dict get $flagset $flag]
|
||||
dict with d {
|
||||
apply $apply $slot $default
|
||||
}
|
||||
} on error {} {
|
||||
error "unrecognized short flag -$flag"
|
||||
}
|
||||
}
|
||||
continue
|
||||
}
|
||||
# stray -flag
|
||||
if {[regexp {^-.*} $x]} {
|
||||
error "unrecognized argument $x"
|
||||
}
|
||||
# the rest arguments are passed through
|
||||
lappend xargs $x
|
||||
}
|
||||
concat $xargs $args
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
proc usage {defs {sections {}} {chan stdout}} {
|
||||
set padding [ComputePadding $defs]
|
||||
dict for {section info} $sections {
|
||||
PrintSection [ExtractSectionDefs defs $section] $info $chan $padding
|
||||
}
|
||||
PrintSection $defs "Generic options" $chan $padding
|
||||
}
|
||||
|
||||
|
||||
proc ComputePadding {defs} {
|
||||
set pad 0
|
||||
foreach def $defs {
|
||||
set x [string length [FormatOpts [Opts $def]]]
|
||||
if {$x > $pad} { set pad $x }
|
||||
}
|
||||
return $pad
|
||||
}
|
||||
|
||||
|
||||
proc ExtractSectionDefs {defsVar section} {
|
||||
upvar $defsVar defs
|
||||
set rest [list]
|
||||
set filtered [list]
|
||||
foreach def $defs {
|
||||
if {[Section $def] == $section} {
|
||||
lappend filtered $def
|
||||
} else {
|
||||
lappend rest $def
|
||||
}
|
||||
}
|
||||
set defs $rest
|
||||
return $filtered
|
||||
}
|
||||
|
||||
|
||||
proc FormatOpts {opts} {
|
||||
set arg 0
|
||||
set x [lmap opt $opts {
|
||||
regexp {(.*?)(=*)$} $opt ~ bare flag
|
||||
if {!$arg && $flag != {}} { set arg 1 }
|
||||
subst $bare
|
||||
}]
|
||||
set x [join $x {, }]
|
||||
if {$arg} { set x "$x <arg>" }
|
||||
return $x
|
||||
}
|
||||
|
||||
|
||||
proc PrintSection {defs info chan padding} {
|
||||
if {[llength $defs]} {
|
||||
incr padding 2
|
||||
if {$info != {}} { puts $chan "\n* $info:\n" }
|
||||
foreach def $defs {
|
||||
set opts [format %${padding}s [FormatOpts [Opts $def]]]
|
||||
puts $chan "$opts [Info $def]"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc Opts {def} { lindex $def 0 }
|
||||
|
||||
|
||||
proc Dict {def} { lrange $def 1 end }
|
||||
|
||||
|
||||
proc Default {def} {
|
||||
try { return [dict get [Dict $def] -default] } on error {} { return 1 }
|
||||
}
|
||||
|
||||
|
||||
proc Section {def} {
|
||||
try { return [dict get [Dict $def] -section] } on error {} { return {} }
|
||||
}
|
||||
|
||||
|
||||
proc Info {def} {
|
||||
try { return [dict get [Dict $def] -info] } on error {} { return {} }
|
||||
}
|
||||
|
||||
|
||||
proc Slot {def} {
|
||||
try { return [dict get [Dict $def] -slot] } on error {} { return {} }
|
||||
}
|
||||
|
||||
|
||||
proc Apply {def} {
|
||||
try { return [list {slot value} [dict get [Dict $def] -apply]] } on error {} { return {{slot value} { upvar 2 $slot x; set x $value }} }
|
||||
}
|
||||
|
||||
|
||||
proc Next {listVar} {
|
||||
upvar $listVar list
|
||||
if {![llength $list]} { error "not enough arguments" }
|
||||
set v [lindex $list 0]
|
||||
set list [lrange $list 1 end]
|
||||
return $v
|
||||
}
|
||||
|
||||
|
||||
# Flags are the parameterless options which receive 1 value when set, ex. -S
|
||||
# Single letter flags may be coalesced, ex. -Sxyz
|
||||
# Multi letter flags must come on their own, ex. -foo
|
||||
proc NormalizeDefs {defs} {
|
||||
set short_flags {}
|
||||
set short_opts {}
|
||||
set long_flags {}
|
||||
set long_opts {}
|
||||
foreach def $defs {
|
||||
set slot [Slot $def]
|
||||
foreach opt [Opts $def] {
|
||||
regexp -- {-+(.*?)=?} $opt ~ bare
|
||||
if {$slot == {}} { set slot $bare }
|
||||
switch -regexp $opt {
|
||||
{^-[[:alnum:]]$} { set kind short_flags }
|
||||
{^-+[[:alnum:]][[:alnum:]\-\_]*$} { set kind long_flags }
|
||||
{^-[[:alnum:]]=$} { set kind short_opts }
|
||||
{^-+[[:alnum:]][[:alnum:]\-\_]*=$} { set kind long_opts }
|
||||
default { error "failed to decode option descriptor $opt" }
|
||||
}
|
||||
lappend $kind [dict create bare $bare slot $slot default [Default $def] apply [Apply $def] info [Info $def] section [Section $def]]
|
||||
}
|
||||
}
|
||||
return [list $short_flags $short_opts $long_flags $long_opts]
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
variable verbose false
|
||||
|
||||
|
||||
variable quiet false
|
||||
|
||||
|
||||
variable staging false
|
||||
|
||||
|
||||
variable premature false
|
||||
|
||||
|
||||
variable cleanup true
|
||||
|
||||
|
||||
variable jobs 0
|
||||
|
||||
|
||||
set opts {
|
||||
{{--jobs= -j=} -info "set maximum number of allowed threads" -default 0 -slot jobs}
|
||||
{{-v --verbose} -info "dump unit output to standard error channel" -default true -slot verbose}
|
||||
{{-T --staging} -info "manage staging directory in \$TMPDIR" -default true -slot staging}
|
||||
{{-K --keep} -info "keep temporary directories & files" -default false -slot cleanup}
|
||||
{{-e --bailout} -info "bail out on first failure" -default true -slot premature}
|
||||
{{-q --quiet} -info "suppress TAP output to standard output channel" -default true -slot quiet}
|
||||
{{-h --help} -info "print help" -apply {
|
||||
puts stderr "usage: $::argv0 {-f --flag --opt=arg --opt arg -opt arg ...} {--} {tag +tag -tag ...}"
|
||||
puts stderr {}
|
||||
puts stderr " +tag | tag instruct to execute only units with specified tag(s)"
|
||||
puts stderr " -tag instruct to skip units with specified tag(s)"
|
||||
clip::usage $testme::opts {} stderr
|
||||
exit 0
|
||||
}}
|
||||
{{--version} -info "print package version" -apply {
|
||||
puts stderr [package require testme]
|
||||
exit 0
|
||||
}}
|
||||
}
|
||||
|
||||
|
||||
if {[catch {
|
||||
if {[llength $::argv]} {set ::argv [clip::parse $::argv $opts]}
|
||||
} return]} {
|
||||
puts stderr $return
|
||||
exit 1
|
||||
}
|
||||
|
||||
|
||||
# TODO
|
||||
if {$jobs == 0} {
|
||||
set jobs 4
|
||||
switch -glob [platform::identify] {
|
||||
linux-* {catch {set jobs [exec nproc --all]}}
|
||||
win32-* {catch {set jobs $env(NUMBER_OF_PROCESSORS)}}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
set +tags [list]
|
||||
set -tags [list]
|
||||
|
||||
|
||||
foreach arg $::argv {
|
||||
switch -glob $arg {
|
||||
+* {lappend +tags [string trimleft $arg +]}
|
||||
-* {lappend -tags [string trimleft $arg -]}
|
||||
default {lappend +tags $arg}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
set ::nesting -1
|
||||
|
||||
|
||||
set paths "eval tcl::tm::path add [tcl::tm::path list]"
|
||||
|
||||
|
||||
set static {
|
||||
|
||||
|
||||
### Execution thread code
|
||||
|
||||
|
||||
proc lshift {var} {
|
||||
upvar 1 $var x
|
||||
set r [lindex $x 0]
|
||||
set x [lrange $x 1 end]
|
||||
return $r
|
||||
}
|
||||
|
||||
|
||||
proc lfront {list} {
|
||||
return [lindex $list 0]
|
||||
}
|
||||
|
||||
|
||||
rename puts ::tcl::puts
|
||||
|
||||
|
||||
proc puts {args} {
|
||||
variable stdout
|
||||
variable stderr
|
||||
set xargs $args
|
||||
if {[llength $args] > 1 && [lfront $args] == "-nonewline"} {
|
||||
lshift args
|
||||
set newline 0
|
||||
} else {
|
||||
set newline 1
|
||||
}
|
||||
switch [llength $args] {
|
||||
1 {set chan stdout}
|
||||
default {set chan [lshift args]}
|
||||
}
|
||||
if {$chan == "stdout" || $chan == "stderr"} {
|
||||
if {$newline} {
|
||||
foreach arg $args {lappend $chan $arg}
|
||||
} else {
|
||||
set $chan [concat [lrange [set $chan] 0 end-1] "[lindex [set $chan] end]$args"]
|
||||
}
|
||||
} else {
|
||||
tcl::puts {*}$xargs
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
proc skip {{reason {}}} {return -code 1073741823 -level 0 $reason}
|
||||
|
||||
|
||||
proc process-unit {unit} {
|
||||
variable stdout [list]
|
||||
variable stderr [list]
|
||||
interp create unit
|
||||
try {
|
||||
interp alias unit puts {} puts
|
||||
interp alias unit skip {} skip
|
||||
unit eval tcl::tm::path add {*}[tcl::tm::path list]
|
||||
catch {unit eval "apply {{unit} {[dict get $unit -code]}} {$unit}"} return opts
|
||||
return [dict merge $opts [dict create -return $return -stdout $stdout -stderr $stderr -id [dict get $unit -id]]]
|
||||
} finally {
|
||||
interp delete unit
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
variable executor [tpool::create -maxworkers $jobs -initcmd "$paths; $static;"]
|
||||
|
||||
|
||||
variable pending [list]
|
||||
|
||||
|
||||
variable skipped [list]
|
||||
|
||||
|
||||
variable units [dict create]
|
||||
|
||||
|
||||
variable id 1
|
||||
|
||||
|
||||
proc union {as bs} {
|
||||
set result $as
|
||||
foreach elem $bs {
|
||||
if {[lsearch -exact $as $elem] == -1} {
|
||||
lappend result $elem
|
||||
}
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
|
||||
proc intersection {as bs} {
|
||||
set result {}
|
||||
foreach elem $bs {
|
||||
if {[lsearch -exact $as $elem] >= 0} {
|
||||
lappend result $elem
|
||||
}
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
|
||||
proc unit {args} {
|
||||
variable executor
|
||||
variable pending
|
||||
variable skipped
|
||||
variable units
|
||||
variable +tags
|
||||
variable -tags
|
||||
variable cleanup
|
||||
variable id
|
||||
set s [llength $args]
|
||||
if {$s < 1 || $s % 2 == 0} {error "usage: testme::unit ?-name ...? ?-tags ...? {...}"}
|
||||
set opts [lrange $args 0 end-1]
|
||||
set code [lindex [lrange $args end end] 0]
|
||||
set name unit[llength $pending]
|
||||
set tags [list]
|
||||
catch {set name [dict get $opts -name]}
|
||||
catch {set tags [dict get $opts -tags]}
|
||||
set tags [lsearch -inline -all -not -exact $tags {}]; # Squeeze out empty {} tags
|
||||
set unit [dict create {*}$opts -stage [pwd] -name $name -tags $tags -code $code -id $id -source $::argv0 -cleanup $cleanup]
|
||||
dict set units $id $unit
|
||||
if {([llength ${+tags}] == 0 || [llength [intersection ${+tags} $tags]] > 0) && [llength [intersection ${-tags} $tags]] == 0} {
|
||||
lappend pending [tpool::post $executor "process-unit {$unit}"]
|
||||
} else {
|
||||
lappend skipped $id
|
||||
}
|
||||
incr id
|
||||
}
|
||||
|
||||
|
||||
if {$staging} {
|
||||
|
||||
|
||||
proc MakeTempDir {args} {
|
||||
set roots $args
|
||||
foreach t {TMPDIR TMP} {
|
||||
if {![catch {set t [set ::env($t)]}]} {
|
||||
lappend roots $t
|
||||
}
|
||||
}
|
||||
lappend roots /tmp
|
||||
foreach r $roots {
|
||||
if {![catch {
|
||||
set t [file join $r [expr {int(rand()*999999)}]]
|
||||
file mkdir $t
|
||||
}]} {
|
||||
return $t
|
||||
}
|
||||
}
|
||||
error "failed to create temporary directory $t"
|
||||
}
|
||||
|
||||
|
||||
set staging [set ::env(TMPDIR) [MakeTempDir]]
|
||||
|
||||
|
||||
if {$verbose} {puts stderr "created temporary directory $staging"}
|
||||
|
||||
}
|
||||
|
||||
|
||||
try {
|
||||
|
||||
|
||||
Import $::argv0
|
||||
|
||||
|
||||
if {!$quiet} {
|
||||
puts "TAP version 14"
|
||||
puts "1..[dict size $units]"
|
||||
foreach s $skipped {
|
||||
set u [dict get $units $s]
|
||||
puts "ok [dict get $u -id] - [dict get $u -name] # SKIP due to tagging"
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
while {[llength $pending]} {
|
||||
foreach f [tpool::wait $executor $pending pending] {
|
||||
set pending [lsearch -inline -all -not -exact $pending $f]
|
||||
set return [tpool::get $executor $f]
|
||||
set u [dict get $units [dict get $return -id]]
|
||||
set name [dict get $u -name]
|
||||
set id [dict get $u -id]
|
||||
if {!$quiet} {
|
||||
switch [dict get $return -code] {
|
||||
0 {puts "ok $id - $name"}
|
||||
1073741823 {puts "ok $id - $name # SKIP [dict get $return -return]"}
|
||||
default {
|
||||
puts "not ok $id - $name"
|
||||
puts " ---"
|
||||
set lines [split [dict get $return -return] "\n"]
|
||||
set r [lindex $lines 0]
|
||||
if {[llength $lines] > 1} {set r "$r >>>"}
|
||||
puts " tags: [dict get $u -tags]"
|
||||
puts " source: [dict get $u -source]"
|
||||
puts " return: $r"
|
||||
puts " ..."
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$verbose} {
|
||||
set stdout [dict get $return -stdout]
|
||||
set stderr [dict get $return -stderr]
|
||||
if {[llength $stdout] + [llength $stderr] > 0} {
|
||||
puts stderr {}
|
||||
puts stderr "- $name"
|
||||
if {[llength $stdout] > 0} {
|
||||
puts stderr "-- stdout:"
|
||||
foreach line $stdout {puts stderr $line}
|
||||
}
|
||||
if {[llength $stderr] > 0} {
|
||||
puts stderr "-- stderr:"
|
||||
foreach line $stderr {puts stderr $line}
|
||||
}
|
||||
}
|
||||
}
|
||||
flush stdout
|
||||
flush stderr
|
||||
if {$premature && [dict get $return -code] != 0} {error "bailing out on failure"}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
} finally {
|
||||
|
||||
|
||||
if {$cleanup && $staging != {false}} {
|
||||
if {[catch {file delete -force -- $staging}]} {
|
||||
if {$verbose} {puts stderr "failed to remove temporary directory $staging"}
|
||||
} else {
|
||||
if {$verbose} {puts stderr "removed temporary directory $staging"}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
exit 0
|
||||
|
||||
|
||||
} on error {return opts} {
|
||||
if {$verbose} {
|
||||
puts stderr $return
|
||||
puts stderr [dict get $opts -errorinfo]
|
||||
}
|
||||
if {!$quiet} {puts "Bail out!"}
|
||||
exit 1
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
### Nested code
|
||||
|
||||
|
||||
if {$::nesting != 0} {
|
||||
set wd [pwd]
|
||||
foreach source [glob -nocomplain [file join * [file tail $::argv0]]] {
|
||||
try {Import $source} finally {cd $wd}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
### Custom code which slurped the testme package's code
|
||||
|
||||
|
||||
proc with {var list code} {
|
||||
upvar 1 $var v
|
||||
if {[catch {set v}]} {set v [list]}
|
||||
set list [concat $v $list]
|
||||
apply [list $var $code] $list
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
54
mingw-w64-mumps/xyz-0.tm
Normal file
54
mingw-w64-mumps/xyz-0.tm
Normal file
@@ -0,0 +1,54 @@
|
||||
package require testme
|
||||
|
||||
|
||||
namespace eval ::xyz {
|
||||
|
||||
|
||||
proc unit {prefix tags args} {
|
||||
testme::unit -tags $tags -name [DescribeXYZ $prefix $tags] -xyz [DeduceXYZ $tags] -static [DeduceStatic $tags] {*}$args
|
||||
}
|
||||
|
||||
|
||||
proc any? {tag tags} {
|
||||
foreach t $tag {
|
||||
if {[lsearch -exact $tags $t] >= 0} {return 1}
|
||||
}
|
||||
return 0
|
||||
}
|
||||
|
||||
|
||||
proc DeduceXYZ {tags} {
|
||||
if {[any? debug $tags]} {set z g} else {set z o}
|
||||
if {[any? mpi $tags]} {set y m} {
|
||||
if {[any? {omp openmp} $tags]} {set y t} else {set y s}
|
||||
}
|
||||
if {[any? complex $tags]} {
|
||||
if {[any? single $tags]} {set x c} else {set x z}
|
||||
} else {
|
||||
if {[any? single $tags]} {set x s} else {set x d}
|
||||
}
|
||||
return $x$y$z
|
||||
}
|
||||
|
||||
|
||||
proc DescribeXYZ {prefix tags} {
|
||||
set prefix "$prefix:"
|
||||
if {[any? single $tags]} {set prefix "$prefix single-precision"}
|
||||
if {[any? double $tags]} {set prefix "$prefix double-precision"}
|
||||
if {[any? complex $tags]} {set prefix "$prefix complex"}
|
||||
if {[any? mpi $tags]} {set prefix "$prefix MPI"} else {if {[any? {omp openmp} $tags]} {set prefix "$prefix OpenMP"}}
|
||||
if {[any? debug $tags]} {set prefix "$prefix debug"}
|
||||
if {[any? c $tags]} {set prefix "$prefix C"}
|
||||
if {[any? fortran $tags]} {set prefix "$prefix FORTRAN"}
|
||||
if {[any? static $tags]} {set prefix "$prefix static"}
|
||||
set prefix "$prefix build"
|
||||
return $prefix
|
||||
}
|
||||
|
||||
|
||||
proc DeduceStatic {tags} {
|
||||
if {[any? static $tags]} {return {-static}} else {return {}}
|
||||
}
|
||||
|
||||
|
||||
}
|
||||
Reference in New Issue
Block a user