1123 lines
52 KiB
Perl
1123 lines
52 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#!/usr/local/bin/perl
|
||
|
|
use strict;
|
||
|
|
use English;
|
||
|
|
use File::Basename; ###---Package pour saisir le nom d un fichier (sans son repertoire)
|
||
|
|
use Cwd; ###---Package pour connaitre le repertoire courant
|
||
|
|
use File::Spec::Functions qw(splitpath rel2abs);###---Package pour utiliser fonctions rel2abs et splitpath (
|
||
|
|
|
||
|
|
|
||
|
|
#nom du programme
|
||
|
|
my $NOM_PROG = basename $PROGRAM_NAME;
|
||
|
|
#pattern d un reel pour les regex (desormais redondant avec $RE{num}{real} de Regexp::Common)
|
||
|
|
my $format_reel = '[+-]?[\.]?\d+[\.]?\d*(?:[eE][+-]?\d*)?';
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
# script pour lancer tous les tests d un repertoire de test
|
||
|
|
#
|
||
|
|
# Notes aux developpeurs :
|
||
|
|
# - utiliser print puis exit au lieu de die (pour envoyer l affichage sur STDOUT et non sur STDERR)
|
||
|
|
# - utiliser print au lieu de warn (meme raison que remarque precedente)
|
||
|
|
#
|
||
|
|
#####################################################################################################
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################
|
||
|
|
#####################################
|
||
|
|
#
|
||
|
|
# PRECISION DES TESTS PAR DEFAUT
|
||
|
|
#
|
||
|
|
#####################################
|
||
|
|
#####################################
|
||
|
|
|
||
|
|
#remarque : a mettre entre guillements (pour des raisons d affichage dans le rapport de test)
|
||
|
|
|
||
|
|
my $PREC_ABSOLU = "1.e-6";#precision pour la comparaison absolue
|
||
|
|
my $PREC_RELATIVE_POURCENT = "1.e-3";#precision pour la comparaison relative (en pourcent)
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################
|
||
|
|
#####################################
|
||
|
|
#
|
||
|
|
# AUTRES PARAMETRES
|
||
|
|
#
|
||
|
|
#####################################
|
||
|
|
#####################################
|
||
|
|
|
||
|
|
#taille maximale du fichier de redirection de l affichage d un calcul Herezh (en octets) rq : le but de cette limite est principalement de contrer le risque de remplissage du disque dur dans le cas ou Herezh affiche en boucle infinie dans le terminal
|
||
|
|
# => fixee a 250 Mo le 2015-04-14
|
||
|
|
# Mo Ko
|
||
|
|
my $TAILLE_MAX_FIC_REDIR = 250*1024*1024;#octets
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
########################### Variables de fichier ###########################
|
||
|
|
my $repertoire_racine = cwd; ###---Repertoire racine (celui dans lequel le script verifier_exeHZ a ete lance)
|
||
|
|
my $repertoire_test; ###---Repertoire test
|
||
|
|
my $fichier_test = 'test0'; ###---Fichier .info a tester
|
||
|
|
my $fichier_rapport = 'rapport_test.txt'; ###---Fichier de rapport des tests
|
||
|
|
my $fichier_temp_maple = 'xxx_princ.maple'; ###---Fichier pour recuperer $valeur
|
||
|
|
my @fichiers; ###---Liste du contenu initial du repertoire de test
|
||
|
|
|
||
|
|
########################### Variables executable Herezh ###########################
|
||
|
|
my $exeHZ; ###---Executable Herezh
|
||
|
|
my $hzchemin; ###---path vers l executable Herezh
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (DEBUT) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#indicateur de l option -h ou -help => affichage aide
|
||
|
|
my $is_opt_help = 0;
|
||
|
|
foreach my $arg (@ARGV) {
|
||
|
|
if($arg =~ /-h/i or $arg =~ /-help/i) {
|
||
|
|
$is_opt_help = 1;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#affichage de l aide si option -h ou -help ou si il n y a pas assez d arguments
|
||
|
|
if($is_opt_help or $#ARGV < 1) {
|
||
|
|
print "USAGE (prog:$NOM_PROG)... \n";
|
||
|
|
print "Ce script Perl s'utilise avec 2 arguments : \n";
|
||
|
|
print " -> 1] Nom du repertoire Test dans lequel se situe un fichier '.info'.\n";
|
||
|
|
print " -> 2] Nom de l executable Herezh\n";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
#nom du repertoire du test
|
||
|
|
$repertoire_test = shift(@ARGV);
|
||
|
|
|
||
|
|
#nom de l executable Herezh
|
||
|
|
$exeHZ = shift(@ARGV);
|
||
|
|
|
||
|
|
#verification de l existence du repertoire de test
|
||
|
|
(-d $repertoire_test) or do {
|
||
|
|
printRapport("$repertoire_test\n -> ECHEC : repertoire $repertoire_test introuvable\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test : repertoire $repertoire_test introuvable\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
|
||
|
|
#verification de la presence d un unique fichier .info dans ce repertoire
|
||
|
|
@_ = glob("$repertoire_test/*.info");
|
||
|
|
my $nb_finfo = $#_ + 1;
|
||
|
|
($nb_finfo == 1) or do {
|
||
|
|
printRapport("$repertoire_test\n -> ECHEC : le repertoire ne contient pas exactement un seul fichier .info (nombre de fichiers trouves : $nb_finfo)\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test : le repertoire ne contient pas exactement un seul fichier .info (nombre de fichiers trouves : $nb_finfo)\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
|
||
|
|
#verification de l executable Herezh (enregistrement du chemin complet dans $hzchemin)
|
||
|
|
$hzchemin = verif_commande($exeHZ);
|
||
|
|
($hzchemin ne '0') or do {
|
||
|
|
printRapport("$repertoire_test\n -> ECHEC : executable Herezh ($exeHZ) introuvable\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test : executable Herezh ($exeHZ) introuvable\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (FIN) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (DEBUT) PRE-TRAITEMENT :
|
||
|
|
# - deplacement dans repertoire de test
|
||
|
|
# - liste du contenu initial de ce repertoire
|
||
|
|
# - nom du fichier .info (sauvegarde du .info d origine en .info_OLD)
|
||
|
|
# - nom du fichier .maple
|
||
|
|
# - verification de la possibilite de lire le fichier .info
|
||
|
|
# - nombre de fichiers .CVisu[no] (on lancera autant de calcul qu il y a de .CVisu)
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
print "\n";
|
||
|
|
print " TYPE DE CALCUL = $exeHZ\n";
|
||
|
|
print "############################################################\n";
|
||
|
|
print "############################################################\n";
|
||
|
|
print "#################### ####################\n";
|
||
|
|
print "#################### DEBUT DE TEST.PL ####################\n";
|
||
|
|
print "#################### ####################\n";
|
||
|
|
print "############################################################\n";
|
||
|
|
print "############################################################\n";
|
||
|
|
print " Nom du repertoire test = $repertoire_test\n";
|
||
|
|
print " $exeHZ se trouve ici : $hzchemin\n";
|
||
|
|
print " Nom du repertoire racine = $repertoire_racine\n";
|
||
|
|
|
||
|
|
#deplacement dans le repertoire de test
|
||
|
|
print " Deplacement dans le repertoire Test\n";
|
||
|
|
chdir ("$repertoire_test");
|
||
|
|
|
||
|
|
#liste du contenu initial du repertoire de test (rq : servira plus tard a retablir l etat d origine du repertoire avant de terminer ce script)
|
||
|
|
@fichiers = glob("*");
|
||
|
|
$_ = $#fichiers + 1;
|
||
|
|
print " Nombre de fichiers dans le repertoire $repertoire_test = $_\n";
|
||
|
|
|
||
|
|
#nom du fichier .info
|
||
|
|
$fichier_test = glob("*.info");
|
||
|
|
$fichier_test =~ s/.info$//;#suppression de l extension
|
||
|
|
print " Nom du fichier teste dans le repertoire test = $fichier_test.info\n";
|
||
|
|
|
||
|
|
#sauvegarde du fichier .info d origine
|
||
|
|
system ("cp -nf $fichier_test.info $fichier_test.info_OLD");
|
||
|
|
|
||
|
|
#nom du fichier .maple
|
||
|
|
$fichier_temp_maple = $fichier_test."_princ.maple";
|
||
|
|
|
||
|
|
#verification de l ouverture du fichier .info
|
||
|
|
open(Finfo, "<$fichier_test.info") or do {
|
||
|
|
printRapport("$repertoire_test\n -> ECHEC : Impossible d'ouvrir $fichier_test.info\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test : Impossible d'ouvrir $fichier_test.info\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
close(Finfo);
|
||
|
|
|
||
|
|
#
|
||
|
|
#nombre de fichiers .CVisu[no] (il doit y en avoir au moins 1)
|
||
|
|
# remarque : si il y a une rupture dans la numerotation, seuls les premiers .CVisu seront exploites
|
||
|
|
# par exemple : si on a : .CVisu1, .CVisu2, .CVisu4 (il manque le 3) => seuls les .CVisu1 et .CVisu2 seront traites (le .CVisu4 sera purement et simplement oublie)
|
||
|
|
my $nb_CVisu = 1;
|
||
|
|
#-premiere verification : presence du fichier .CVisu1
|
||
|
|
(-e "$fichier_test.CVisu$nb_CVisu") or do {
|
||
|
|
printRapport("$repertoire_test\n -> ECHEC : fichier $fichier_test.CVisu1 introuvable\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test : fichier $fichier_test.CVisu1 introuvable\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
#-autres fichiers .CVisu
|
||
|
|
LOOP1:while() {
|
||
|
|
my $indice_tmp = $nb_CVisu + 1;
|
||
|
|
foreach my $fic (@fichiers) {
|
||
|
|
if(-e "$fichier_test.CVisu$indice_tmp") {
|
||
|
|
$nb_CVisu++;
|
||
|
|
next LOOP1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
print " Nombre de fichiers .CVisu dans le repertoire test = $nb_CVisu\n";
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (FIN) PRE-TRAITEMENT
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (DEBUT) LANCEMENT DES TESTS (un test par fichier .CVisu)
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
################################################
|
||
|
|
#(debut) boucle de test (sur les numeros de .CVisu)
|
||
|
|
################################################
|
||
|
|
# **IMPORTANT : ne pas utiliser de "die", "exit" ou autre sortie brutale dans cette boucle. Utiliser a la place l instruction " last BOUCLE_TEST; " pour sortir simplement de la boucle et permettre a ce script de faire des derniers traitements avant de quitter
|
||
|
|
BOUCLE_TEST:for(my $no_test=1; $no_test<=$nb_CVisu; $no_test++) {
|
||
|
|
|
||
|
|
print "\n";
|
||
|
|
print " --------------------------------------\n";
|
||
|
|
print " lancement test fichier .CVisu$no_test\n";
|
||
|
|
print " --------------------------------------\n";
|
||
|
|
print "\n";
|
||
|
|
|
||
|
|
#ecriture du repertoire de test et .CVisu en cours dans le rapport
|
||
|
|
printRapport("$repertoire_test/.CVisu$no_test\n");
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
# SAISIE DES EVENTUELS FICHIERS FACULTATIFS : - fichier de commande .commande
|
||
|
|
# - fichier de precision .precision
|
||
|
|
# - script de verification .verif
|
||
|
|
# - fichier d options .option
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
#####################################################################################################
|
||
|
|
my $fic_commande = ""; $fic_commande = "$fichier_test.commande$no_test" if(-e "$fichier_test.commande$no_test");
|
||
|
|
my $fic_precision = ""; $fic_precision = "$fichier_test.precision$no_test" if(-e "$fichier_test.precision$no_test");
|
||
|
|
my $script_verif = ""; $script_verif = "$fichier_test.verif$no_test" if(-e "$fichier_test.verif$no_test");
|
||
|
|
my $fic_option = ""; $fic_option = "$fichier_test.option$no_test" if(-e "$fichier_test.option$no_test");
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
# CONSTRUCTION DE LA COMMANDE HEREZH
|
||
|
|
# rq : en l absence d un fichier .option, on considere qu il s agit d un calcul (-f fic.info) si le mot-cle dimension est repere dans le fichier .info
|
||
|
|
# sinon, on considere qu il s agit d une creation de fichier .info (-n fic.info)
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
#####################################################################################################
|
||
|
|
#---initialisation de la commande a lancer
|
||
|
|
my $cmd_HZ = "";
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#---cas d un fichier d options (la commande est construite via le contenu du fichier $fic_option si il existe)
|
||
|
|
#################################################################################
|
||
|
|
if(-e $fic_option) {
|
||
|
|
open(FIC, "<$fic_option");
|
||
|
|
while(<FIC>) {
|
||
|
|
next if(/^\s*\#/);
|
||
|
|
next if(/^\s*$/);
|
||
|
|
chomp;
|
||
|
|
$cmd_HZ .= " $_";
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
}
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#---cas general (pas de fichier .option => calcul -f ou creation .info -n)
|
||
|
|
#################################################################################
|
||
|
|
else {
|
||
|
|
##############################################################
|
||
|
|
#---calcul classique (option -f) : mode selectionne si le mot-cle dimension est repere dans le fichier .info
|
||
|
|
# => on s assure que le mot-cle controle est present pour gerer les RESTART
|
||
|
|
##############################################################
|
||
|
|
if(is_mot_in_fic("$fichier_test.info", '^\s*dimension ', '#')) {
|
||
|
|
#ajout de "-f fic.info" a la commande Herezh
|
||
|
|
$cmd_HZ .= " -f $fichier_test.info";
|
||
|
|
|
||
|
|
#---verification : la presence du mot-cle controle est necessaire (pour la gestion des RESTART)
|
||
|
|
# => on ajoute ce mot-cle si besoin (avant le mot-cle resultats qui est obligatoire)
|
||
|
|
if(not is_mot_in_fic("$fichier_test.info", '^\s*controle', '#')) {#ajout du mot-cle controle si besoin
|
||
|
|
open(Finfo, "<$fichier_test.info");
|
||
|
|
open(Finfo_tmp, ">$fichier_test.info.tmp");
|
||
|
|
my $presence_mot_cle_resultats = 0;#indicateur de presence du mot-cle resultats
|
||
|
|
while(<Finfo>) {
|
||
|
|
if(/^\s*resultats/) {#le mot-cle resultats est repere => ecriture du mot-cle controle
|
||
|
|
$presence_mot_cle_resultats = 1;
|
||
|
|
print Finfo_tmp "\ncontrole\n\n";
|
||
|
|
}
|
||
|
|
print Finfo_tmp;
|
||
|
|
}
|
||
|
|
close(Finfo);
|
||
|
|
close(Finfo_tmp);
|
||
|
|
system("mv -f $fichier_test.info.tmp $fichier_test.info");
|
||
|
|
#on verifie que le mot-cle resultats a bien ete trouve (et donc que donc le mot-cle controle a bien ete ecrit)
|
||
|
|
$presence_mot_cle_resultats or do {
|
||
|
|
printRapport(" -> ECHEC : le mot-cle resultats n a pas ete trouve dans le fichier $fichier_test.info (impossible de rajouter le mot-cle controle)\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : le mot-cle resultats n a pas ete trouve dans le fichier $fichier_test.info (impossible de rajouter le mot-cle controle)\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
}
|
||
|
|
|
||
|
|
#---activation eventuelle d un RESTART si existence du .PI
|
||
|
|
#-numero du dernier increment
|
||
|
|
my $incr_restart = 0;
|
||
|
|
# rq : si le fichier .PI n existe pas, $incr_restart restera egal a 0 (pas d activation du RESTART)
|
||
|
|
# sinon, $incr_restart sera egal au dernier increment lu dans le fichier .PI
|
||
|
|
open(FIC, "<$fichier_test.PI");
|
||
|
|
while(<FIC>) {
|
||
|
|
last if(/^\s*$/);
|
||
|
|
next if(not /^\s*incre_posi_\(nb_et_posi\):\s+(\d+)/);
|
||
|
|
$incr_restart = $1;
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
#-reecriture du .info avec RESTART (si $incr_restart different de 0)
|
||
|
|
active_RESTART("$fichier_test.info", $incr_restart);
|
||
|
|
}
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#---cas d une creation de fichier .info (option -n)
|
||
|
|
# => on s assure qu un fichier .commande existe
|
||
|
|
##############################################################
|
||
|
|
else {
|
||
|
|
#ajout de "-n fic.info" a la commande Herezh
|
||
|
|
$cmd_HZ .= " -n $fichier_test.info";
|
||
|
|
|
||
|
|
#--- la presence d un fichier de commande est obligatoire pour une creation de fichier .info
|
||
|
|
if(not -e $fic_commande) {
|
||
|
|
printRapport(" -> ECHEC : probleme pour un test de creation de fichier .info (option -n) => le fichier $fic_commande est obligatoire et n a pas ete trouve\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : probleme pour un test de creation de fichier .info (option -n) => le fichier $fic_commande est obligatoire et n a pas ete trouve\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#---suppression des espaces multiples dans la commande et des espaces en debut et en fin
|
||
|
|
# (pas forcement utile, c est juste a titre de prevention...)
|
||
|
|
#################################################################################
|
||
|
|
$cmd_HZ =~ s/\s+/ /g;
|
||
|
|
$cmd_HZ =~ s/^\s+//;
|
||
|
|
$cmd_HZ =~ s/\s+$//;
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
# LANCEMENT DU CALCUL
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
#####################################################################################################
|
||
|
|
|
||
|
|
#recopie du .CVisu[$no_test] vers .CVisu
|
||
|
|
system("cp -nf $fichier_test.CVisu$no_test $fichier_test.CVisu");
|
||
|
|
|
||
|
|
#lancement de la commande via subroutine lancement_commande() dont les arguments sont :
|
||
|
|
# 1- chemin complet vers l executable Herezh
|
||
|
|
# 2- la commande Herezh construite precedemment
|
||
|
|
# 3- le nom du fichier de redirection de l affichage Herezh
|
||
|
|
# 4- le nom du fichier .commande
|
||
|
|
|
||
|
|
my $status_calcul = lancement_commande($hzchemin, $cmd_HZ, "$fichier_test.log", $fic_commande);
|
||
|
|
|
||
|
|
# - si calcul a termine normalement (converge ou non) => $status_calcul = "ok"
|
||
|
|
# - si calcul a conduit a un trop gros fichier de redirection => $status_calcul = "depassement taille maximum"
|
||
|
|
# - si probleme de redirection d affichage => $status_calcul = "probleme redirection affichage"
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
# VERIFICATION DU TEST
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
#####################################################################################################
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#premiere verification selon status renvoye par la subroutine lancement_commande
|
||
|
|
#################################################################################
|
||
|
|
#---cas d un calcul ayant conduit a un trop gros fichier de redirection
|
||
|
|
if($status_calcul eq "depassement taille maximum") {
|
||
|
|
printRapport(" -> ECHEC : le calcul Herezh a conduit a la creation d un trop gros fichier de redirection (fichier $fichier_test.log a depasse la taille maximum autorisee egale a $TAILLE_MAX_FIC_REDIR octets).\n");
|
||
|
|
printRapport(" Les causes possibles sont un probleme de menu interactif, un long calcul associe a une frequence trop grande d affichage des increments et iterations, ...\n");
|
||
|
|
printRapport(" Si ce depassement est un fonctionnement normal, il faut augmenter la taille admissible dans la variable \$TAILLE_MAX_FIC_REDIR au debut du script de test $NOM_PROG pour rendre possible ce test.\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul Herezh a conduit a la creation d un trop gros fichier de redirection (fichier $fichier_test.log a depasse la taille maximum autorisee egale a $TAILLE_MAX_FIC_REDIR octets).\n";
|
||
|
|
print " Les causes possibles sont un probleme de menu interactif, un long calcul associe a une frequence trop grande d affichage des increments et iterations, ...\n";
|
||
|
|
print " Si ce depassement est un fonctionnement normal, il faut augmenter la taille admissible dans la variable \$TAILLE_MAX_FIC_REDIR au debut du script de test $NOM_PROG pour rendre possible ce test.\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
}
|
||
|
|
#---cas d un probleme de redirection d affichage (sans doute probleme lie a la commande "tee")
|
||
|
|
elsif($status_calcul eq "probleme redirection affichage") {
|
||
|
|
printRapport(" -> ECHEC : il y a eu un probleme dans la redirection de l affichage via la commande \"tee\" (le fichier $fichier_test.log n a pas ete cree). Cause possible : commande tee introuvable\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : il y a eu un probleme dans la redirection de l affichage via la commande \"tee\" (le fichier $fichier_test.log n a pas ete cree). Cause possible : commande tee introuvable\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
}
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#cas d une verification via un script dedie (fichier .verif)
|
||
|
|
#################################################################################
|
||
|
|
if(-e $script_verif) {
|
||
|
|
|
||
|
|
print " Comparaison via un script : utilisation de $script_verif\n";
|
||
|
|
|
||
|
|
#verification des droits du script (doit etre executable. si il n est pas executable, on le rend executable)
|
||
|
|
system("chmod +x $script_verif") if(not -x $script_verif);
|
||
|
|
|
||
|
|
#execution du script (avec redirection vers un .log)
|
||
|
|
system("rm -f $script_verif.log");
|
||
|
|
system("$script_verif $exeHZ | tee $script_verif.log");
|
||
|
|
|
||
|
|
#saisie du resultat (on s attend a trouver une chaine de la forme "resultat verification : STATUS" dans le .log)
|
||
|
|
my $resu_verif = '';
|
||
|
|
open(FIC, "<$script_verif.log");
|
||
|
|
while(<FIC>) {
|
||
|
|
next if(not /^\s*resultat\s+verification\s*:\s*(\S+)/i);#rq : recherche insensible a la casse
|
||
|
|
$resu_verif = $1;
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
|
||
|
|
#verif du resultat (doit etre ECHEC ou OK)
|
||
|
|
($resu_verif eq 'OK' or $resu_verif eq 'ECHEC') or do {
|
||
|
|
printRapport(" -> ECHEC : resultat non conforme de la verification via le script $script_verif. Cause possible : la chaine \"resultat verification : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : resultat non conforme de la verification via le script $script_verif. Cause possible : la chaine \"resultat verification : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
|
||
|
|
printRapport(" -> $resu_verif (resultat fourni par le script de verification $script_verif)\n\n");
|
||
|
|
}#if(-e $script_verif)
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#cas d une verification classique (comparaison entre .maple et .maple.ref[$no_test])
|
||
|
|
# rq : on suppose qu il s agit d une verification classique si il y a la presence d un fichier .maple.ref
|
||
|
|
#################################################################################
|
||
|
|
elsif(-e "$fichier_temp_maple.ref$no_test") {
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# pretraitement
|
||
|
|
##############################################################
|
||
|
|
#nom du fichier maple de reference
|
||
|
|
my $fichier_ref_maple = "$fichier_temp_maple.ref$no_test";
|
||
|
|
|
||
|
|
print " Comparaison maple : utilisation de $fichier_ref_maple\n";
|
||
|
|
|
||
|
|
#liste des donnees contenues dans le fichier maple de reference
|
||
|
|
my @donnees_ref_maple = ();
|
||
|
|
#liste des donnees contenues dans le fichier maple du calcul en cours
|
||
|
|
my @donnees_temp_maple = ();
|
||
|
|
#liste des precisions absolues
|
||
|
|
my @precisions_abolues = ();
|
||
|
|
#liste des precisions relatives
|
||
|
|
my @precisions_relatives = ();
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# saisie des donnees du fichier maple de reference
|
||
|
|
##############################################################
|
||
|
|
open(FIC, "<$fichier_ref_maple") or do {
|
||
|
|
printRapport(" -> ECHEC : impossible d ouvrir fichier maple de reference $fichier_ref_maple\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir fichier maple de reference $fichier_ref_maple\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
while(<FIC>) {
|
||
|
|
next if(not /^\s*$format_reel/);
|
||
|
|
$_ =~ s/^\s+//; $_ =~ s/\s+$//;#suppression d espaces eventuels en debut et fin
|
||
|
|
@donnees_ref_maple = split(/\s+/, $_);
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# saisie des donnees du fichier maple du calcul en cours
|
||
|
|
##############################################################
|
||
|
|
open(FIC, "<$fichier_temp_maple") or do {
|
||
|
|
printRapport(" -> ECHEC : impossible d ouvrir fichier maple $fichier_temp_maple (cause possible : erreur execution Herezh)\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir fichier maple $fichier_temp_maple (cause possible : erreur execution Herezh)\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
while(<FIC>) {
|
||
|
|
next if(not /^\s*$format_reel/);
|
||
|
|
$_ =~ s/^\s+//; $_ =~ s/\s+$//;#suppression d espaces eventuels en debut et fin
|
||
|
|
@donnees_temp_maple = split(/\s+/, $_);
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# verification sur les donnees : nombre de donnees de reference doit etre egal au nombre de donnees generees par le calcul en cours
|
||
|
|
##############################################################
|
||
|
|
($#donnees_temp_maple == $#donnees_ref_maple) or do {
|
||
|
|
printRapport(" -> ECHEC : pas le meme nombre de valeurs en sortie dans le .maple et dans le maple.ref$no_test\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : pas le meme nombre de valeurs en sortie dans le .maple et dans le .maple.ref$no_test\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# constitution des listes de precision
|
||
|
|
##############################################################
|
||
|
|
#---initialisation avec les precisions par defaut
|
||
|
|
for(my $i=0; $i<=$#donnees_temp_maple; $i++) {
|
||
|
|
$precisions_abolues[$i] = $PREC_ABSOLU;
|
||
|
|
$precisions_relatives[$i] = $PREC_RELATIVE_POURCENT;
|
||
|
|
}
|
||
|
|
#---modification eventuelle des precisions si un fichier .precision existe
|
||
|
|
if(-e $fic_precision) {
|
||
|
|
open(Fprec, "<$fic_precision") or do {
|
||
|
|
printRapport(" -> ECHEC : impossible d ouvrir le fichier de precision $fic_precision\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : impossible d ouvrir le fichier de precision $fic_precision\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
while(<Fprec>) {
|
||
|
|
next if(not /^\s*\[\s*(\d+)\s*\]\s+($format_reel)\s+($format_reel)/);
|
||
|
|
$precisions_abolues[$1-1] = "$2";
|
||
|
|
$precisions_relatives[$1-1] = "$3";
|
||
|
|
print " modif precision absolue pour colonne $1 : precision absolue = $2\n";
|
||
|
|
print " modif precision relative pour colonne $1 : precision relative = $3\n";
|
||
|
|
}
|
||
|
|
close(Fprec);
|
||
|
|
}
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# boucle de comparaison des donnees (test entre chaque valeur des listes @donnees_temp_maple et @donnees_ref_maple)
|
||
|
|
##############################################################
|
||
|
|
for(my $i_valeur=0; $i_valeur<=$#donnees_temp_maple; $i_valeur++) {
|
||
|
|
#numero de colonne dans le .maple
|
||
|
|
my $no_colonne_maple = $i_valeur + 1;
|
||
|
|
|
||
|
|
#valeur a comparer
|
||
|
|
my $valeur_temp = $donnees_temp_maple[$i_valeur];#calcul en cours
|
||
|
|
my $valeur_ref = $donnees_ref_maple[$i_valeur];#valeur de reference
|
||
|
|
|
||
|
|
#precisions
|
||
|
|
my $precision_absolue = $precisions_abolues[$i_valeur];
|
||
|
|
my $precision_relative = $precisions_relatives[$i_valeur];
|
||
|
|
|
||
|
|
#nombre de decimales des precisions (pour afficher des valeurs arrondies dans le rapport de test)
|
||
|
|
my $nb_decimales_prec_absolue = return_nb_decimales($precision_absolue);
|
||
|
|
my $nb_decimales_prec_relative = return_nb_decimales($precision_relative);
|
||
|
|
|
||
|
|
#difference absolue arrondie au nombre de decimales de la precision $precision_absolue
|
||
|
|
my $diff_absolue = sprintf("%.${nb_decimales_prec_absolue}f", $valeur_temp - $valeur_ref);
|
||
|
|
|
||
|
|
#difference relative en pourcent arrondie au nombre de decimale de la precision $precision_relative
|
||
|
|
my $diff_relative_pourcent;
|
||
|
|
#-si $valeur_temp et $valeur_ref sont nulles, pas de souci, la difference relative est forcement nulle
|
||
|
|
if($valeur_ref == 0 and $valeur_temp == 0) {
|
||
|
|
$diff_relative_pourcent = sprintf("%.${nb_decimales_prec_relative}f", 0.);
|
||
|
|
}
|
||
|
|
#si $valeur_ref est nulle mais pas $valeur_temp, la comparaison relative est impossible
|
||
|
|
elsif($valeur_ref == 0) {
|
||
|
|
$diff_relative_pourcent = "impossible car valeur de reference egale a 0";
|
||
|
|
}
|
||
|
|
#cas general : difference relative par rapport a $valeur_ref
|
||
|
|
else {
|
||
|
|
$diff_relative_pourcent = sprintf("%.${nb_decimales_prec_relative}f", 100.*($valeur_temp-$valeur_ref)/$valeur_ref);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#ouverture du rapport de test
|
||
|
|
open (FSOR, ">> $repertoire_racine/Rapport/$fichier_rapport") || do {
|
||
|
|
printRapport("$repertoire_test/.CVisu$no_test\n -> ECHEC : Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n\n");
|
||
|
|
print "**Erreur Test $repertoire_test/.CVisu$no_test : Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n";
|
||
|
|
last BOUCLE_TEST;
|
||
|
|
};
|
||
|
|
|
||
|
|
print FSOR " -> grandeur testee : colonne \[$no_colonne_maple\]\n";
|
||
|
|
|
||
|
|
#############################
|
||
|
|
#comparaison absolue };
|
||
|
|
#############################
|
||
|
|
#---OK
|
||
|
|
if(abs($diff_absolue) <= $PREC_ABSOLU) {
|
||
|
|
print FSOR " - comparaison absolue (precision : $precision_absolue) -> OK\n";
|
||
|
|
}
|
||
|
|
#---ECHEC
|
||
|
|
else {
|
||
|
|
print FSOR " - comparaison absolue (precision : $precision_absolue) -> ECHEC\n";
|
||
|
|
print FSOR " -> Valeur = $valeur_temp\n";
|
||
|
|
print FSOR " -> Valeur reference = $valeur_ref\n";
|
||
|
|
print FSOR " -> Difference = $diff_absolue\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
#############################
|
||
|
|
#comparaison relative
|
||
|
|
#############################
|
||
|
|
#---cas d une comparaison impossible => affichage d un message d erreur (mais pas du mot ECHEC : ce n est pas un echec car la valeur de reference est egale a 0)
|
||
|
|
if($diff_relative_pourcent =~ /impossible/) {
|
||
|
|
print FSOR " - comparaison relative : impossible car valeur de reference egale a 0\n";
|
||
|
|
}
|
||
|
|
#---OK
|
||
|
|
elsif(abs($diff_relative_pourcent) <= $precision_relative) {
|
||
|
|
print FSOR " - comparaison relative (precision : $precision_relative\%) -> OK\n";
|
||
|
|
}
|
||
|
|
#---ECHEC
|
||
|
|
else {
|
||
|
|
print FSOR " - comparaison relative (precision : $precision_relative\%) -> ECHEC\n";
|
||
|
|
print FSOR " -> Valeur = $valeur_temp\n";
|
||
|
|
print FSOR " -> Valeur reference = $valeur_ref\n";
|
||
|
|
print FSOR " -> Difference relative = $diff_relative_pourcent\%\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
print FSOR "\n";
|
||
|
|
}#for(my $i_valeur=0; $i_valeur<=$#donnees_temp_maple; $i_valeur++)
|
||
|
|
close (FSOR);
|
||
|
|
|
||
|
|
}#elsif(-e $fichier_temp_maple)
|
||
|
|
|
||
|
|
|
||
|
|
#################################################################################
|
||
|
|
#cas sans verification
|
||
|
|
#################################################################################
|
||
|
|
else {
|
||
|
|
printRapport(" -> OK (pas de verification pour ce test)\n\n");
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
# DERNIERS TRAITEMENT AVANT LANCEMENT DU PROCHAIN .CVisu
|
||
|
|
#----------------------------------------------------------------------------------------------------
|
||
|
|
#####################################################################################################
|
||
|
|
|
||
|
|
#suppression du fichier de redirection
|
||
|
|
system("rm -f $fichier_test.log");
|
||
|
|
|
||
|
|
#suppression des eventuels fichiers resultats (ATTENTION : ne pas supprimer les fichiers .BI et .PI pour permettre un RESTART)
|
||
|
|
#--- fichier .maple
|
||
|
|
system ("rm -f $fichier_temp_maple");
|
||
|
|
#--- fichiers Gmsh
|
||
|
|
system ("rm -rf $fichier_test\_Gmsh.msh $fichier_test\_Gmsh");
|
||
|
|
#--- fichiers _cab.isoe
|
||
|
|
system ("rm -f $fichier_test*_cab.isoe");
|
||
|
|
#--- fichier reac
|
||
|
|
system ("rm -f $fichier_test.reac");
|
||
|
|
#--- fichier res
|
||
|
|
system ("rm -f $fichier_test.res");
|
||
|
|
#--- fichier cont
|
||
|
|
system ("rm -f $fichier_test.cont");
|
||
|
|
#--- fichier ddl
|
||
|
|
system ("rm -f $fichier_test.ddl");
|
||
|
|
#--- fichiers _dpl.points
|
||
|
|
system ("rm -f $fichier_test*_dpl.points");
|
||
|
|
#--- fichier ancienNom
|
||
|
|
system ("rm -f ancienNom");
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
}#BOUCLE_TEST:for(my $no_test=1; $no_test<=$nb_CVisu; $no_test++)
|
||
|
|
################################################
|
||
|
|
#(fin) boucle de test (sur les numeros de .CVisu)
|
||
|
|
################################################
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# (FIN) LANCEMENT DES TESTS
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# FIN DU SCRIPT : derniers traitements avant sortie
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
# derniers traitements avant retour au repertoire racine
|
||
|
|
#####################################################################################################
|
||
|
|
|
||
|
|
#restauration du .info d origine
|
||
|
|
system("mv -f $fichier_test.info_OLD $fichier_test.info");
|
||
|
|
|
||
|
|
#suppression de tout ce qui n etait pas present initialement dans le repertoire de test (fichiers et repertoires)
|
||
|
|
my %TAB_FICHIER_INITIAL;
|
||
|
|
#---on cree une table d indicateur de presence pour les fichiers initiaux (fichiers et repertoires contenus dans la liste @fichiers qui a ete constituee en debut de script)
|
||
|
|
foreach my $fic (@fichiers) {$TAB_FICHIER_INITIAL{$fic} = 1;}
|
||
|
|
#---et on supprime tout ce qui n a pas d indicateur
|
||
|
|
foreach my $fic (glob("*")) {
|
||
|
|
next if(defined($TAB_FICHIER_INITIAL{$fic}));#pas de suppression en cas d indicateur
|
||
|
|
system("rm -rf $fic");
|
||
|
|
}
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
# retour au repertoire racine
|
||
|
|
#####################################################################################################
|
||
|
|
print " Deplacement jusqu'au repertoire d'origine\n";
|
||
|
|
chdir($repertoire_racine);
|
||
|
|
|
||
|
|
print "##########################################################\n";
|
||
|
|
print "##########################################################\n";
|
||
|
|
print "#################### ####################\n";
|
||
|
|
print "#################### FIN DE TEST.PL ####################\n";
|
||
|
|
print "#################### ####################\n";
|
||
|
|
print "##########################################################\n";
|
||
|
|
print "##########################################################\n";
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# SUBROUTINES
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine pour ecrire une chaine de caractere dans le fichier de rapport des tests : $repertoire_racine/Rapport/$fichier_rapport
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - chaine de caracteres a afficher dans le rapport
|
||
|
|
#
|
||
|
|
sub printRapport {
|
||
|
|
open(FSOR, ">>$repertoire_racine/Rapport/$fichier_rapport") or do {
|
||
|
|
print "Impossible d'ouvrir $repertoire_racine/Rapport/$fichier_rapport\n";
|
||
|
|
exit;
|
||
|
|
};
|
||
|
|
print FSOR $_[0];
|
||
|
|
close(FSOR);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine pour lancer la commande Herezh
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - executable Herezh (IMPORTANT : chemin complet vers la commande. Par exemple : ../HZpp, /Users/dupont/bin/HZppfast, ./HZppfast, ...)
|
||
|
|
# - commande (une chaine de caracteres donnant les instructions a la suite de l executable Herezh. Par exemple : -f fic.info)
|
||
|
|
# - fichier redirection affichage (fichier pour redirection affichage avec "tee")
|
||
|
|
# - fichier de commande (reponses en interactif)
|
||
|
|
#
|
||
|
|
# en sortie :
|
||
|
|
# - indicateur sur le status du calcul : "ok" si calcul a termine (converge ou non)
|
||
|
|
# "depassement taille maximum" si calcul a conduit a un depassement du maximum autorise pour la taille du fichier de redirection
|
||
|
|
# "probleme redirection affichage" si la redirection de l affichage n a pas ete faite correctement (dans ce cas, probleme lie a la commande tee)
|
||
|
|
#
|
||
|
|
sub lancement_commande {
|
||
|
|
|
||
|
|
my $hzchemin_original = shift;
|
||
|
|
my $commande = shift;
|
||
|
|
my $fredir_tee = shift;
|
||
|
|
my $fic_commande = shift;
|
||
|
|
|
||
|
|
#suppression d un eventuel fichier de redirection deja existant
|
||
|
|
system("rm -f $fredir_tee");
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#creation d un lien symbolique vers l executable Herezh original
|
||
|
|
# rq : l utilite de ce lien est qu il permettra de rechercher les pid de processus en reperant ce nom unique genere aleatoirement (pour eviter de tuer d autres processus Herezh qui n ont rien a voir avec la batterie de test)
|
||
|
|
##############################################################
|
||
|
|
#creation d un nom aleatoire
|
||
|
|
my $lien_symbolique_HZ = 'HZ'.int(rand(99999999999));
|
||
|
|
#creation du lien symbolique
|
||
|
|
system("ln -s $hzchemin_original $lien_symbolique_HZ");
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#creation de la commande
|
||
|
|
##############################################################
|
||
|
|
my $cmd = "$lien_symbolique_HZ $commande";
|
||
|
|
#on ajoute des reponses interactives si le fichier $fic_commande existe
|
||
|
|
$cmd .= " < $fic_commande" if(-e $fic_commande);
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#lancement du calcul Herezh dans un processus fils
|
||
|
|
# rq : redirection de l affichage dans le fichier $fredir_tee
|
||
|
|
##############################################################
|
||
|
|
my $PID_CALCUL = fork();
|
||
|
|
#
|
||
|
|
#le bloc suivant ne concerne que le processus fils
|
||
|
|
if($PID_CALCUL == 0) {
|
||
|
|
#lancement du calcul Herezh
|
||
|
|
system("$cmd | tee $fredir_tee");
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
#pause de 0.5 seconde pour laisser le temps de lancer la commande
|
||
|
|
select(undef, undef, undef, 0.5);
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#recuperation des pid de processus Herezh (dans la variable @HZpid)
|
||
|
|
# rq : pour pouvoir les tuer en cas de probleme
|
||
|
|
##############################################################
|
||
|
|
#saisie de la liste des processus sous la forme "pid commande" en ne gardant que les processus comportant la chaine $lien_symbolique_HZ pour l utilisateur courant $ENV{USER}
|
||
|
|
my @processus = qx(ps -U $ENV{USER} -o pid,command | grep $lien_symbolique_HZ);
|
||
|
|
#on ne garde que le pid des processus et on les stocke dans @HZpid
|
||
|
|
my @HZpid = ();
|
||
|
|
foreach my $processus (@processus) {
|
||
|
|
next if(not $processus =~ /^\s*(\d+)/);
|
||
|
|
push(@HZpid, $1);
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#on s assure que le fichier de redirection a ete cree
|
||
|
|
# si ce n est pas le cas, on retourne un probleme lie a la redirection de l affichage
|
||
|
|
##############################################################
|
||
|
|
if(not -e $fredir_tee) {
|
||
|
|
#suppression des processus de calcul
|
||
|
|
kill("TERM", @HZpid) if(@HZpid ne "");
|
||
|
|
#attente de la fin du processus fils de lancement du calcul
|
||
|
|
waitpid($PID_CALCUL, 0);
|
||
|
|
#suppression lien symbolique
|
||
|
|
system("rm -f $lien_symbolique_HZ");
|
||
|
|
|
||
|
|
return "probleme redirection affichage";
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# surveillance en continu de la taille du fichier de redirection dans un processus fils
|
||
|
|
##############################################################
|
||
|
|
#le fichier $fic_communication permettra d indiquer au processus pere que le fichier $fredir_tee a depasse la taille maximum autorisee $TAILLE_MAX_FIC_REDIR octets
|
||
|
|
# et il permet egalement au processus fils de savoir si la surveillance n est plus necessaire
|
||
|
|
my $fic_communication = "$lien_symbolique_HZ.communication";
|
||
|
|
system("rm -f $fic_communication");
|
||
|
|
|
||
|
|
my $PID_TAILLE_FIC_REDIR = fork();
|
||
|
|
#
|
||
|
|
#le bloc suivant ne concerne que le processus fils
|
||
|
|
if($PID_TAILLE_FIC_REDIR == 0) {
|
||
|
|
while() {
|
||
|
|
#pause de 0.5 seconde
|
||
|
|
select(undef, undef, undef, 0.5);
|
||
|
|
|
||
|
|
#taille actuelle du fichier
|
||
|
|
my $taille_fichier = -s $fredir_tee;
|
||
|
|
|
||
|
|
#si la taille du fichier a depasse la limite => on cree le fichier de communication, on tue les processus de calcul et on sort de la boucle
|
||
|
|
if($taille_fichier > $TAILLE_MAX_FIC_REDIR) {
|
||
|
|
system("echo 1 > $fic_communication");
|
||
|
|
kill("TERM", @HZpid) if($#HZpid > -1);
|
||
|
|
last;
|
||
|
|
}
|
||
|
|
|
||
|
|
#on arrete cette boucle si le fichier $fic_communication a ete cree par le processus pere
|
||
|
|
# rq : si c est le cas, cela veut dire que le processus fils $PID_CALCUL s est arrete normalement
|
||
|
|
# et que donc la surveillance n est plus necessaire
|
||
|
|
last if(-e $fic_communication);
|
||
|
|
}
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
#attente de la fin du processus fils du lancement du calcul
|
||
|
|
##############################################################
|
||
|
|
waitpid($PID_CALCUL, 0);
|
||
|
|
|
||
|
|
#suppression du lien symbolique qui ne sert plus desormais
|
||
|
|
system("rm -f $lien_symbolique_HZ");
|
||
|
|
|
||
|
|
|
||
|
|
##############################################################
|
||
|
|
# verification de l etat du calcul
|
||
|
|
##############################################################
|
||
|
|
|
||
|
|
#si le fichier $fic_communication existe, cela veut dire qu il a ete cree par le processus fils $PID_TAILLE_FIC_REDIR et que donc il y a eu un depassement de la taille maximum autorisee
|
||
|
|
# => status calcul = depassement taille maximum
|
||
|
|
if(-e $fic_communication) {
|
||
|
|
#on s assure que le processus fils de surveillance s est termine proprement
|
||
|
|
waitpid($PID_TAILLE_FIC_REDIR, 0);
|
||
|
|
#suppression du fichier de communication
|
||
|
|
system("rm -f $fic_communication");
|
||
|
|
|
||
|
|
return "depassement taille maximum";
|
||
|
|
}
|
||
|
|
|
||
|
|
#si le fichier $fic_communication n existe pas, alors ca veut dire que le calcul Herezh s est arrete normalement (qu il ait converge ou non)
|
||
|
|
# => status calcul = ok
|
||
|
|
else {
|
||
|
|
#on envoie un signal au processus fils $PID_TAILLE_FIC_REDIR
|
||
|
|
system("echo 1 > $fic_communication");
|
||
|
|
#on attend la fin du processus fils $PID_TAILLE_FIC_REDIR
|
||
|
|
waitpid($PID_TAILLE_FIC_REDIR, 0);
|
||
|
|
#on supprime le fichier de communication
|
||
|
|
system("rm -f $fic_communication");
|
||
|
|
|
||
|
|
return 'ok';
|
||
|
|
}
|
||
|
|
|
||
|
|
}#sub lancement_commande
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine qui recherche l existence d une commande et renvoie le premier path trouve (renvoie 0 si commande introuvable)
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - nom de la commande
|
||
|
|
#
|
||
|
|
# en sortie :
|
||
|
|
# - chemin de la commande (0 si commande introuvable)
|
||
|
|
#
|
||
|
|
sub verif_commande {
|
||
|
|
my $cmd = shift;#nom de la commande
|
||
|
|
|
||
|
|
#cas d une commande en chemin absolu
|
||
|
|
return $cmd if(-x $cmd);
|
||
|
|
|
||
|
|
#cas d une commande en chemin relatif (rq : dans le cas d un chemin relatif, si la commande n existe pas, on renvoie 0)
|
||
|
|
if($cmd =~ /^\./) {
|
||
|
|
return $cmd if(-x $cmd);
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
#on regarde dans la variable environnement $PATH
|
||
|
|
foreach my $path (split(/\s*:\s*/, $ENV{PATH})) {
|
||
|
|
return "$path/$cmd" if(-x "$path/$cmd");
|
||
|
|
}
|
||
|
|
|
||
|
|
#cas ou la commande est introuvable
|
||
|
|
return 0;
|
||
|
|
}#sub verif_commande
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine pour activer/desactiver RESTART dans fichier .info
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - nom du fichier .info
|
||
|
|
# - numero d increment de RESTART (0 pour desactiver RESTART)
|
||
|
|
sub active_RESTART {
|
||
|
|
my $finfo = shift;#nom fichier .info
|
||
|
|
my $increment = shift;#increment de RESTART
|
||
|
|
|
||
|
|
#suppression d un eventuel RESTART deja present
|
||
|
|
open(Finfo, "<$finfo");
|
||
|
|
open(Finfo_tmp, ">$finfo.tmp");
|
||
|
|
while(<Finfo>) {
|
||
|
|
next if(/^\s*RESTART /);#pas d ecriture si la ligne commence par RESTART
|
||
|
|
|
||
|
|
print Finfo_tmp;#ecriture de la ligne du fichier d origine
|
||
|
|
|
||
|
|
#ajout de RESTART si la ligne actuelle est positionnee au mot-cle controle et que $increment n est pas egal a 0
|
||
|
|
if(/^\s*controle/ and $increment > 0) {
|
||
|
|
print Finfo_tmp "RESTART $increment\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close(Finfo);
|
||
|
|
close(Finfo_tmp);
|
||
|
|
system("mv -f $finfo.tmp $finfo");
|
||
|
|
}#sub active_RESTART
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine qui renvoie le nombre de decimales d un reel
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - un reel
|
||
|
|
#
|
||
|
|
# en sortie :
|
||
|
|
# - nombre de decimales
|
||
|
|
#
|
||
|
|
sub return_nb_decimales {
|
||
|
|
my $nombre = shift;
|
||
|
|
$nombre = "$nombre";
|
||
|
|
return 0 if($nombre =~ /^\d+$/);#cas d un entier
|
||
|
|
|
||
|
|
#saisie d une eventuelle puissance de 10
|
||
|
|
my $exp = 0;
|
||
|
|
$nombre =~ s/[Ee]([+-]?\d+)//;
|
||
|
|
$exp = $1 if(defined($1));
|
||
|
|
|
||
|
|
#calcul du nombre de decimales du reel sans son eventuelle puissance de 10
|
||
|
|
my @tab = split(//, $nombre);
|
||
|
|
my $nb_decimales = 0;
|
||
|
|
my $i;
|
||
|
|
for($i=0; $i<=$#tab; $i++) {last if($tab[$i] eq '.');}
|
||
|
|
for(my $j=$i+1; $j<=$#tab; $j++) {$nb_decimales++;}
|
||
|
|
|
||
|
|
#rajout du decalage de virgule selon l eventuelle puissance de 10
|
||
|
|
$nb_decimales -= $exp;
|
||
|
|
|
||
|
|
return $nb_decimales;
|
||
|
|
}#sub return_nb_decimales
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine pour rechercher la presence d un mot dans un fichier en parcourant egalement les sous-fichiers
|
||
|
|
# declares dans le fichier (lignes de la forme : "< nom_fichier")
|
||
|
|
#####################################################################################################
|
||
|
|
# en entree :
|
||
|
|
# - arg 1 : nom du fichier
|
||
|
|
# - arg 2 : mot a trouver
|
||
|
|
# - arg 3 : symbole de fin de ligne (par exemple le symbole # pour un fichier .info)
|
||
|
|
#
|
||
|
|
# en sortie :
|
||
|
|
# - renvoie 1 si le fichier ou l un de ses sous-fichiers contient le mot
|
||
|
|
# renvoie 0 si le mot n a pas ete trouve ou si le fichier n est pas lisible
|
||
|
|
#
|
||
|
|
sub is_mot_in_fic {
|
||
|
|
local $_;
|
||
|
|
|
||
|
|
my $fic = shift;#fichier a traiter
|
||
|
|
my $mot = shift;#mot a rechercher
|
||
|
|
my $symbole_fin_ligne = shift;#symbole indiquant la fin d une ligne
|
||
|
|
|
||
|
|
#repertoire du fichier (on utilise le chemin absolu pour connaitre ce repertoire)
|
||
|
|
my $rep_absolu = ( splitpath(rel2abs $fic) )[1];
|
||
|
|
|
||
|
|
#parcours du fichier (et enregistrement de ses eventuels sous-fichiers)
|
||
|
|
my @sous_fic;#liste des sous-fichiers
|
||
|
|
open(FIC, "<$fic") or return 0;#on renvoie 0 si le fichier n est pas lisible
|
||
|
|
while(<FIC>) {
|
||
|
|
#troncature de la ligne selon le premier symbole $symbole_fin_ligne trouve
|
||
|
|
s/${symbole_fin_ligne}.*$//;
|
||
|
|
|
||
|
|
#cas ou le mot a ete trouve (on ferme le fichier et on renvoie "vrai")
|
||
|
|
if(/$mot/) {
|
||
|
|
close(FIC);
|
||
|
|
return 1;
|
||
|
|
}#if(/$mot/)
|
||
|
|
|
||
|
|
#cas d un sous-fichier (on garde son nom pour l instant en lui ajoutant le repertoire du fichier)
|
||
|
|
push(@sous_fic, "$rep_absolu$1") if(/^\s*\<\s*(\S+)/);
|
||
|
|
}#while(<FIC>)
|
||
|
|
close(FIC);
|
||
|
|
|
||
|
|
#parcours des sous-fichiers
|
||
|
|
foreach my $sous_fic (@sous_fic) {
|
||
|
|
#repertoire du sous-fichier (rq : le chemin de $sous_fic est deja absolu, donc pas besoin de faire appel a la sub rel2abs() )
|
||
|
|
$rep_absolu = ( splitpath $sous_fic)[1];
|
||
|
|
open(FIC, "<$sous_fic") or next;#on ne fait rien si le fichier n est pas lisible
|
||
|
|
while(<FIC>) {
|
||
|
|
#troncature de la ligne selon le premier symbole $symbole_fin_ligne trouve
|
||
|
|
s/${symbole_fin_ligne}.*$//;
|
||
|
|
|
||
|
|
#cas ou le mot a ete trouve (on ferme le fichier et on renvoie "vrai")
|
||
|
|
if(/$mot/) {
|
||
|
|
close(FIC);
|
||
|
|
return 1;
|
||
|
|
}#if(/$mot/)
|
||
|
|
|
||
|
|
#cas d un sous-fichier de sous-fichier (est-ce vraiment raisonnable!!!!) (on l ajoute a la liste)
|
||
|
|
push(@sous_fic, "$rep_absolu$1") if(/^\s*\<\s*(\S+)/);
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
}
|
||
|
|
|
||
|
|
return 0;
|
||
|
|
}#sub is_mot_in_fic
|