# Copyright (C) 2001-2017 Yves Renard
#
# This file is a part of GetFEM++
#
# GetFEM++ is free software; you can redistribute it and/or modify it
# under the terms of the GNU Lesser General Public License as published
# by the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version along with the GCC Runtime Library
# Exception either version 3.1 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 Lesser General Public
# License and GCC Runtime Library Exception for more details.
# You should have received a copy of the GNU Lesser General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
eval 'exec perl -S $0 "$@"'
if 0;
sub numerique { $a <=> $b; }
$nb_iter = 1; # number of iterations on each test
$islocal = 0;
$with_qd = 0; # test also with dd_real and qd_real
$with_lapack = 0; # link with lapack
$srcdir = $ENV{srcdir}; # source directory
$tests_to_be_done = "";
$fix_base_type = -1;
while(@ARGV) { # read optional parameters
$param = $ARGV[0];
$val = int(1 * $param);
if ($param =~ /.cc/) {
$tests_to_be_done = $param;
}
elsif ($param eq "with-qd") {
$with_qd = 1;
}
elsif ($param eq "with-lapack") {
$with_lapack = 1;
}
elsif ($param eq "float") {
$fix_base_type = 0;
}
elsif ($param eq "double") {
$fix_base_type = 1;
}
elsif ($param eq "complex_float") {
$fix_base_type = 2;
}
elsif ($param eq "complex_double") {
$fix_base_type = 3;
}
elsif ($param eq "dd_real") {
$fix_base_type = 0; $with_qd = 1;
}
elsif ($param eq "qd_real") {
$fix_base_type = 1; $with_qd = 1;
}
elsif ($param eq "complex_dd_real") {
$fix_base_type = 2; $with_qd = 1;
}
elsif ($param eq "complex_qd_real") {
$fix_base_type = 3; $with_qd = 1;
}
elsif ($param =~ "srcdir=") {
($param, $srcdir)=split('=', $param, 2);
}
elsif ($val != 0) {
$nb_iter = $val;
}
else {
print "Unrecognized parameter: $param\n";
print "valid parameters are:\n";
print ". the number of iterations on each test\n";
print ". with-qd : test also with dd_real and qd_real\n";
print ". with-lapack : link with lapack\n";
print ". double, float, complex_double or complex_float";
print " to fix the base type\n";
print ". source name of a test procedure\n";
print ". srcdir=name\n";
exit(1);
}
shift @ARGV;
}
if ($srcdir eq "") {
$srcdir="../../tests";
print "WARNING : no srcdir, taking $srcdir\n";
$islocal = 1;
}
if ($tests_to_be_done eq "") {
$tests_to_be_done = `ls $srcdir/gmm_torture*.cc`; # list of tests
}
if ($with_qd && $with_lapack) {
print "Options with_qd and with_lapack are not compatible\n";
exit(1);
}
$nb_test = 0; # number of test procedures
$tests_list = $tests_to_be_done;
while ($tests_list)
{ ($org_name, $tests_list) = split('\s', $tests_list, 2); ++$nb_test; }
print "Gmm tests : Making $nb_iter execution";
if ($nb_iter > 1) { print "s"; }
if ($nb_test == 1) { print " of $tests_to_be_done\n"; }
else { print " of each test\n"; }
for ($iter = 1; $iter <= $nb_iter; ++$iter) {
$tests_list = $tests_to_be_done;
while ($tests_list) {
($org_name, $tests_list) = split('\s', $tests_list, 2);
if ($nb_iter == 1) { print "Testing $org_name"; }
else { print "Test $iter for $org_name"; }
if ($with_lapack) { print " linked with lapack"; }
if ($with_qd) { print " with qd types"; }
print "\n";
$d = $org_name;
do { ($b, $d) = split('/', $d, 2); } while ($d);
$dest_name = "auto_$b";
($root_name, $d) = split('.cc', $dest_name, 2);
$size_max = 30.0;
open(DATAF, $org_name) or die "Open input file impossible : $!\n";
open(TMPF, ">$dest_name") or die "Open output file impossible : $!\n";
print TMPF "\n\n";
if ($with_lapack) {
print TMPF "#include<gmm_lapack_interface.h>\n\n";
}
if ($with_qd) {
print TMPF "#include <qd/dd.h>\n";
print TMPF "#include <qd/qd.h>\n";
print TMPF "#include <qd/fpu.h>\n\n";
}
$reading_param = 1;
$nb_param = 0;
while (($li = <DATAF> )&& ($reading_param)) {
chomp($li);
if ($li=~/^\/\//) {
if ($li=~/ENDPARAM/) { $reading_param = 0; }
elsif ($li=~/DENSE_VECTOR_PARAM/) { $param[$nb_param++] = 1; }
elsif ($li=~/VECTOR_PARAM/) { $param[$nb_param++] = 2; }
elsif ($li=~/RECTANGULAR_MATRIX_PARAM/) { $param[$nb_param++] = 3; }
elsif ($li=~/SQUARED_MATRIX_PARAM/) { $param[$nb_param++] = 4; }
elsif ($li=~/\/\//) { }
else { die "Error in parameter list"; }
}
}
$TYPES[0] = "float";
$TYPES[1] = "std::complex<float> ";
$TYPES[2] = "double";
$TYPES[3] = "std::complex<double> ";
# $TYPES[4] = "long double";
# $TYPES[5] = "std::complex<long double> ";
$NB_TYPES = 4.0;
if ($with_lapack) {
$NB_TYPES = 4.0;
}
if ($with_qd) {
$TYPES[0] = "dd_real";
$TYPES[1] = "qd_real";
$TYPES[2] = "std::complex<dd_real> ";
$TYPES[3] = "std::complex<qd_real> ";
$NB_TYPES = 4.0;
}
if ($fix_base_type == -1) { $TYPE = $TYPES[int($NB_TYPES * rand())]; }
else { $TYPE = $TYPES[$fix_base_type]; }
$VECTOR_TYPES[0] = "std::vector<$TYPE> ";
$VECTOR_TYPES[1] = "std::vector<$TYPE> ";
$VECTOR_TYPES[2] = "gmm::rsvector<$TYPE> ";
$VECTOR_TYPES[3] = "gmm::wsvector<$TYPE> ";
$VECTOR_TYPES[4] = "gmm::slvector<$TYPE> ";
$NB_VECTOR_TYPES = 5.0;
$MATRIX_TYPES[0] = "gmm::dense_matrix<$TYPE> ";
$MATRIX_TYPES[1] = "gmm::dense_matrix<$TYPE> ";
$MATRIX_TYPES[2] = "gmm::row_matrix<std::vector<$TYPE> > ";
$MATRIX_TYPES[3] = "gmm::col_matrix<std::vector<$TYPE> > ";
$MATRIX_TYPES[4] = "gmm::row_matrix<gmm::rsvector<$TYPE> > ";
$MATRIX_TYPES[5] = "gmm::col_matrix<gmm::rsvector<$TYPE> > ";
$MATRIX_TYPES[6] = "gmm::row_matrix<gmm::wsvector<$TYPE> > ";
$MATRIX_TYPES[7] = "gmm::col_matrix<gmm::wsvector<$TYPE> > ";
$MATRIX_TYPES[8] = "gmm::row_matrix<gmm::slvector<$TYPE> > ";
$MATRIX_TYPES[9] = "gmm::col_matrix<gmm::slvector<$TYPE> > ";
$NB_MATRIX_TYPES = 10.0;
while ($li = <DATAF>) { print TMPF $li; }
$sizep = int($size_max*rand());
$theseed = int(10000.0*rand());
# print "Parameters for the test:\n";
print TMPF "\n\n\n";
print TMPF "int main(void) {\n\n";
if ($with_qd) {
print TMPF " fpu_fix_start(0);\n\n";
}
print TMPF " srand($theseed);\n\n";
print TMPF " gmm::set_warning_level(1);\n\n";
print TMPF " for (int iter = 0; iter < 100000; ++iter) {\n\n";
print TMPF " try {\n\n";
for ($j = 0; $j < $nb_param; ++$j) {
$a = rand(); $b = rand();
if ($with_lapack) { $a = $b = 1.0; }
$sizepp = $sizep + int(50.0*rand());
$step = $sizep; if ($step == 0) { ++$step; }
$step = int(1.0*int($sizepp/$step - 1)*rand()) + 1;
if (($param[$j] == 1) || ($param[$j] == 2)) { # vectors
$lt = $VECTOR_TYPES[0];
if ($param[$j] == 2 && $with_lapack==0) {
$lt = $VECTOR_TYPES[int($NB_VECTOR_TYPES * rand())];
}
if ($a < 0.1) {
$li = " $lt param$j($sizepp);";
$c = int(1.0*($sizepp-$sizep+1)*rand());
$param_name[$j]
= "gmm::sub_vector(param$j, gmm::sub_interval($c, $sizep))";
}
elsif ($a < 0.2) {
$li = " $lt param$j($sizepp);";
$c = int(1.0*($sizepp-($sizep*$step+1))*rand());
$param_name[$j]
= "gmm::sub_vector(param$j, gmm::sub_slice($c, $sizep, $step))";
}
elsif ($a < 0.3) {
$li = " $lt param$j($sizepp);"; @sub_index = ();
@sortind = 0 .. ($sizepp-1);
while (@sortind)
{ push (@sub_index, splice(@sortind , rand @sortind, 1)); }
@sub_index = @sub_index[0..$sizep-1];
@sub_index = sort numerique @sub_index;
if ($sizep == 0)
{ $li = "$li\n gmm::size_type param_tab$j [1] = {0};"; }
else {
$li="$li\n gmm::size_type param_tab$j [$sizep] ={$sub_index[0]";
for ($k = 1; $k < $sizep; ++$k) { $li = "$li , $sub_index[$k]"; }
$li = "$li};";
}
$param_name[$j] = "gmm::sub_vector(param$j,".
" gmm::sub_index(¶m_tab$j [0], ¶m_tab$j [$sizep]))";
}
else {
$li = " $lt param$j($sizep);";
$param_name[$j] = "param$j";
}
print TMPF "$li\n gmm::fill_random(param$j);\n";
}
elsif ($param[$j] == 3 || $param[$j] == 4) { # matrices
$sm = $sizep; if ($a < 0.3) { $sm = $sizep + int(50.0*rand()); }
$s = $sizep; if ($param[$j] == 3) { $s = int($size_max*rand()); }
$sn = $s; if ($b < 0.3) { $sn = $s + int(50.0*rand()); }
$param_name[$j] = "param$j";
$lt = $MATRIX_TYPES[0];
if ($with_lapack==0) {
$lt = $MATRIX_TYPES[int($NB_MATRIX_TYPES * rand())];
}
$li = " $lt param$j($sm, $sn);";
if ($a < 0.3 || $b < 0.3) {
$sub1 = "gmm::sub_interval(0, $sizep)";
$sub2 = "gmm::sub_interval(0, $s)";
if ($a < 0.1) {
$c = int(1.0*($sm-$sizep+1)*rand());
$sub1 = "gmm::sub_interval($c, $sizep)";
}
elsif ($a < 0.2) {
$step = $sizep; if ($step == 0) { ++$step; }
$step = int(1.0*int($sm/$step - 1)*rand()) + 1;
$c = int(1.0*($sm-($sizep*$step+1))*rand());
$sub1 = "gmm::sub_slice($c, $sizep, $step)";
}
elsif ($a < 0.3) {
@sub_index = ();
@sortind = 0 .. ($sm-1);
while (@sortind)
{ push (@sub_index, splice(@sortind , rand @sortind, 1)); }
@sub_index = @sub_index[0..$sizep-1];
@sub_index = sort numerique @sub_index;
if ($sizep == 0)
{ $li = "$li\n gmm::size_type param_t$j [1] = {0};"; }
else {
$li="$li\n gmm::size_type param_t$j [$sizep]= {$sub_index[0]";
for ($k = 1; $k < $sizep; ++$k) { $li = "$li , $sub_index[$k]"; }
$li = "$li};";
}
$sub1 = "gmm::sub_index(¶m_t$j [0], ¶m_t$j [$sizep])";
}
if ($b < 0.1) {
$c = int(1.0*($sn-$s+1)*rand());
$sub2 = "gmm::sub_interval($c, $s)";
}
elsif ($b < 0.2) {
$step = $s; if ($step == 0) { ++$step; }
$step = int(1.0*int($sn/$step - 1)*rand()) + 1;
$c = int(1.0*($sn-($s*$step+1))*rand());
$sub2 = "gmm::sub_slice($c, $s, $step)";
}
elsif ($b < 0.3) {
@sub_index = ();
@sortind = 0 .. ($sn-1);
while (@sortind)
{ push (@sub_index, splice(@sortind , rand @sortind, 1)); }
@sub_index = @sub_index[0..$s-1];
@sub_index = sort numerique @sub_index;
if ($s == 0)
{ $li = "$li\n gmm::size_type param_u$j [1] = {0};"; }
else {
$li="$li\n gmm::size_type param_u$j [$s] = {$sub_index[0]";
for ($k = 1; $k < $s; ++$k) { $li = "$li , $sub_index[$k]"; }
$li = "$li};";
}
$sub2 = "gmm::sub_index(¶m_u$j [0], ¶m_u$j [$s])";
}
$param_name[$j] = "gmm::sub_matrix(param$j, $sub1, $sub2)";
}
if (1.0 * rand() < 0.5) {
print TMPF "$li\n gmm::fill_random(param$j);\n";
}
else {
print TMPF "$li\n gmm::fill_random(param$j, 0.2);\n";
}
$sizep = $s;
}
# print "$li ($param_name[$j])\n";
}
print TMPF " \n\n bool ret = test_procedure($param_name[0]";
for ($j = 1; $j < $nb_param; ++$j) { print TMPF ", $param_name[$j]"; }
print TMPF ");\n";
print TMPF " if (ret) return 0;\n\n";
print TMPF " }\n";
print TMPF " GMM_STANDARD_CATCH_ERROR;\n";
print TMPF " }\n";
print TMPF " return 0;\n";
print TMPF "}\n";
close(DATAF);
close(TMPF);
`rm -f $root_name`;
$compilo=`sh ../gmm-config --cxx` || die('cannot execute ../gmm-config --cxx'); chomp($compilo);
$compile_options=`sh ../gmm-config --build-flags`;
chomp($compile_options);
$compile_options="$compile_options -I$srcdir/../src -I$srcdir/../include -I../src -I../include";
$compile_libs="-lm";
if ($with_lapack) {
$compile_libs="-llapack -lblas -lg2c $compile_libs";
$compile_options="$compile_options -DGMM_USES_LAPACK"
}
if ($with_qd) { $compile_libs="-lqd $compile_libs"; }
# print "$compilo $compile_options $dest_name -o $root_name $compile_libs\n";
print `$compilo $compile_options $dest_name -o $root_name $compile_libs`;
if ($? != 0) {
print "$compilo $compile_options $dest_name -o $root_name $compile_libs\n";
print "\n******************************************************\n";
print "* Compilation error, please submit this bug to\n";
print "* Yves.Renard\@insa-lyon.fr, with the file\n";
print "* $dest_name\n";
print "* produced in directory \"tests\".\n";
print "******************************************************\n";
exit(1);
}
print `./$root_name`;
if ($? != 0) {
print "$compilo $compile_options $dest_name -o $root_name $compile_libs\n";
print "\n******************************************************\n";
print "* Execution error, please submit this bug to\n";
print "* Yves.Renard\@insa-lyon.fr, with the file\n";
print "* $dest_name\n";
print "* produced in directory \"tests\".\n";
print "******************************************************\n";
exit(1);
}
# `rm -f $dest_name`;
}
}