2015-10-01 00:56:53 +02:00
#!/usr/bin/env perl
2015-04-14 21:36:00 +02:00
use strict ;
2015-04-22 17:18:47 +02:00
use warnings ;
2015-04-14 21:36:00 +02:00
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)
2016-03-11 17:47:39 +01:00
# - ce programme capture le signal d interruption Ctrl-c(INT) ou kill -15(TERM) (application de la subroutine arret_force() en cas d interruption)
# (i.e pas d arret immediat de ce script)
2015-04-14 21:36:00 +02:00
#
#####################################################################################################
#####################################
#####################################
#
# PRECISION DES TESTS PAR DEFAUT
#
#####################################
#####################################
#remarque : a mettre entre guillements (pour des raisons d affichage dans le rapport de test)
2018-03-15 14:14:01 +01:00
my $ PREC_ABSOLU_DEFAUT = "1.e-6" ; #precision par defaut pour la comparaison absolue : |X - Xref| <= precision
my $ PREC_RELATIVE_DEFAUT = "1.e-3" ; #precision par defaut pour la comparaison relative : |(X - Xref) / Xref| <= precision
2015-04-14 21:36:00 +02:00
#####################################
#####################################
#
# AUTRES PARAMETRES
#
#####################################
#####################################
2015-04-22 17:18:47 +02:00
#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 beaucoup trop de chose dans le terminal
2015-04-14 21:36:00 +02:00
# => fixee a 250 Mo le 2015-04-14
# Mo Ko
my $ TAILLE_MAX_FIC_REDIR = 250 * 1024 * 1024 ; #octets
########################### Variables de fichier ###########################
2015-11-25 10:00:06 +01:00
my $ repertoire_racine = cwd ; ###---Repertoire racine (celui dans lequel le script verifier_exeHZ a ete lance)
my $ repertoire_test ; ###---Repertoire test (il s agit du repertoire original, sachant que le test sera concretement execute dans le repertoire $repertoire_de_travail defini par la suite)
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
my $ repertoire_de_travail = "/tmp/$NOM_PROG\_$$" ; ###---Repertoire de travail dans lequel les tests vont etre reellement executes
### (NE PAS MODIFIER LE FAIT QUE CE SOIT SUR /tmp ... au pire, il faut au moins que ce
### soit un chemin absolu et vers un repertoire facilement disponible sur n importe quelle OS Mac ou Linux)
### Le choix actuel (2015-11-25) a ete de nommer ce repertoire en fonction du nom de ce script suivi du pid
### du processus, ce qui a priori le rend unique)
2016-03-11 17:47:39 +01:00
2015-04-14 21:36:00 +02:00
########################### Variables executable Herezh ###########################
my $ exeHZ ; ###---Executable Herezh
my $ hzchemin ; ###---path vers l executable Herezh
2016-03-11 17:47:39 +01:00
########################### Variables pour la communication avec un script verifier_exeHZ.pl ###########################
my $ pid_verifier_exeHZ ; ###---pid du processus verifier_exeHZ.pl qui a lance ce script de test (fourni comme 3eme argument facultatif)
my $ fic_communication ; ###---Fichier pour communiquer avec le script verifier_exeHZ.pl (rq : variable inutile dans le cas du script verifier_exeHZ.zsh)
2015-04-14 21:36:00 +02:00
##########################################################################
##########################################################################
##########################################################################
#
# (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" ;
2015-07-15 13:42:40 +02:00
print "Ce script Perl s utilise avec 2 arguments : \n" ;
print " -> 1] Nom du repertoire Test dans lequel se situe un fichier \'.info\'.\n" ;
2015-04-14 21:36:00 +02:00
print " -> 2] Nom de l executable Herezh\n" ;
2016-03-11 17:47:39 +01:00
print " -> 3] (facultatif) pid du processus verifier_exeHZ.pl qui a lance ce script\n" ;
2015-04-14 21:36:00 +02:00
exit ;
}
#nom du repertoire du test
$ repertoire_test = shift ( @ ARGV ) ;
#nom de l executable Herezh
$ exeHZ = shift ( @ ARGV ) ;
2016-03-11 17:47:39 +01:00
#pid du processus verifier_exeHZ.pl qui a lance ce script (argument facultatif)
$ pid_verifier_exeHZ = shift ( @ ARGV ) if ( $# ARGV > - 1 ) ;
2015-04-14 21:36:00 +02:00
#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 ;
} ;
2016-03-11 17:47:39 +01:00
#verif de l existence d un fichier de communication dont serait egal a : /tmp/verifier_exeHZ_2_test_[$pid_verifier_exeHZ].com
if ( defined $ pid_verifier_exeHZ ) {
$ fic_communication = "/tmp/verifier_exeHZ_2_test_$pid_verifier_exeHZ.com" ;
( - e $ fic_communication ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : fichier de communication ($fic_communication) introuvable\n\n" ) ;
print "**Erreur Test $repertoire_test : fichier de communication ($fic_communication) introuvable\n" ;
exit ;
} ;
}
2015-04-14 21:36:00 +02:00
##########################################################################
##########################################################################
##########################################################################
#
# (FIN) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT
#
##########################################################################
##########################################################################
##########################################################################
2016-03-11 17:47:39 +01:00
##########################################################################
##########################################################################
##########################################################################
#
# (DEBUT) GESTION D UNE INTERRUPTION (Ctrl-c ou kill -15)
# => on capture les signaux d interruption et on utilise la variable $ARRET_FORCE pour terminer proprement le programme
#
##########################################################################
##########################################################################
##########################################################################
#indicateur d un arret force (=1 si arret)
# rq : cette variable sert a plusieurs endroits pour gerer l interruption proprement :
# - dans la sub lancement_commande() (voir LOOP_SURVEILLANCE:while() )
# - dans le status du test (voir VERIFICATION DU TEST dans la boucle BOUCLE_TEST:for(...)
my $ ARRET_FORCE = 0 ;
#subroutine arret_force : - sera appelee pour toute interruption Ctrl-c (signal INT) ou kill -15 (signal TERM)
# - ne ferme pas le programme (on utilise la variable $ARRET_FORCE pour quitter la boucle de test et terminer normalement le programme)
sub arret_force {
#on stoppe tout simplement si aucun pid de processus n a ete donne en argument (variable : $pid_verifier_exeHZ)...
exit if ( not defined $ pid_verifier_exeHZ ) ;
#...sinon, on applique la procedure d arret en collaboration avec le script verifier_exeHZ.pl qui a appele ce script :
#1) on indique l arret force via la variable $ARRET_FORCE pour quitter proprement le test en cours
$ ARRET_FORCE = 1 ;
#2) on envoie un signal d arret a verifier_exeHZ.pl (au cas ou il ne l a pas deja eu, ce qui peut arriver quand on lance un processus Herezh via un open(PIPE, |....))
kill ( "TERM" , $ pid_verifier_exeHZ ) ;
}
#capture : Ctrl-c (INT)
$ SIG { INT } = \ & arret_force ;
#capture : kill -15 (TERM)
$ SIG { TERM } = \ & arret_force ;
##########################################################################
##########################################################################
##########################################################################
#
# (FIN) GESTION D UNE INTERRUPTION (Ctrl-c ou kill -15)
#
##########################################################################
##########################################################################
##########################################################################
2015-04-14 21:36:00 +02:00
##########################################################################
##########################################################################
##########################################################################
#
# (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)
#
##########################################################################
##########################################################################
##########################################################################
2015-11-25 10:00:06 +01:00
#verification prealable que le repertoire de travail $repertoire_de_travail specifie dans l en-tete de ce script est bien un
# repertoire en chemin absolu (si ce n est pas le cas, il pourrait y avoir de graves problemes d execution, donc autant bien verifier maintenant)
( $ repertoire_de_travail =~ /^\s*\// ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : le repertoire de travail ($repertoire_de_travail) specifie dans l en-tete du script $NOM_PROG doit etre en chemin absolu (veuillez modifier la variable \$repertoire_de_travail du script $0)\n\n" ) ;
print "**Erreur Test $repertoire_test : le repertoire de travail ($repertoire_de_travail) specifie dans l en-tete du script $NOM_PROG doit etre en chemin absolu (veuillez modifier la variable \$repertoire_de_travail du script $0)\n" ;
exit ;
} ;
2015-04-14 21:36:00 +02:00
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" ) ;
2015-11-25 10:00:06 +01:00
#liste du contenu initial du repertoire de test
2015-04-14 21:36:00 +02:00
@ 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" ;
#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)
2015-11-25 10:00:06 +01:00
# rq : l execution des tests se fait dans le repertoire
# de travail $repertoire_de_travail afin de ne jamais modifier le repertoire d origine
2015-04-14 21:36:00 +02:00
#
##########################################################################
##########################################################################
##########################################################################
2015-11-25 10:00:06 +01:00
#recopie du contenu du repertoire vers le repertoire temporaire (on nomme ce repertoire en fonction de la variable Perl $$ qui est le PID du processus actuel)
system ( "rm -rf $repertoire_de_travail" ) ; #suppression si il existe deja (improbable!!)
mkdir $ repertoire_de_travail ; #creation du repertoire
#verif de sa creation
( - d $ repertoire_de_travail ) or do {
printRapport ( "$repertoire_test\n -> ECHEC : Impossible de creer le repertoire de travail $repertoire_de_travail\n\n" ) ;
print "**Erreur Test $repertoire_test : Impossible de creer le repertoire de travail $repertoire_de_travail\n" ;
exit ;
} ;
#recopie des fichiers vers $repertoire_de_travail
foreach my $ fic ( @ fichiers ) {
#cas d un repertoire
if ( - d $ fic ) { system ( "cp -R $fic $repertoire_de_travail/." ) ; }
#cas d un fichier
else { system ( "cp $fic $repertoire_de_travail/." ) ; }
}
#deplacement dans le repertoire de travail
2016-07-01 15:49:33 +02:00
print " Deplacement dans le repertoire temporaire de travail : $repertoire_de_travail\n" ;
2015-11-25 10:00:06 +01:00
chdir $ repertoire_de_travail ;
2017-01-04 18:52:58 +01:00
2015-04-14 21:36:00 +02:00
################################################
#(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
2015-11-25 10:00:06 +01:00
printRapport ( "\n\n$repertoire_test/.CVisu$no_test\n" ) ;
2015-04-14 21:36:00 +02:00
2017-01-04 18:52:58 +01:00
2015-04-14 21:36:00 +02:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# SAISIE DES EVENTUELS FICHIERS FACULTATIFS : - fichier de commande .commande
# - fichier de precision .precision
# - script de verification .verif
2015-04-29 18:36:49 +02:00
# - fichier d arguments .argument
2016-03-24 14:36:54 +01:00
# - fichier pre-traitement .pretrait
# - fichier post-traitement .posttrait
2015-04-14 21:36:00 +02:00
#----------------------------------------------------------------------------------------------------
#####################################################################################################
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" ) ;
2015-04-30 09:35:11 +02:00
my $ fic_argument = "" ; $ fic_argument = "$fichier_test.argument$no_test" if ( - e "$fichier_test.argument$no_test" ) ;
2016-03-24 14:36:54 +01:00
my $ script_pretrait = "" ; $ script_pretrait = "$fichier_test.pretrait$no_test" if ( - e "$fichier_test.pretrait$no_test" ) ;
my $ script_posttrait = "" ; $ script_posttrait = "$fichier_test.posttrait$no_test" if ( - e "$fichier_test.posttrait$no_test" ) ;
2015-04-14 21:36:00 +02:00
2017-01-04 18:52:58 +01:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# EVENTUEL PRE-TRAITEMENT (si presence du fichier $script_pretrait)
#----------------------------------------------------------------------------------------------------
#####################################################################################################
if ( - e $ script_pretrait ) {
#verification des droits du script (doit etre executable. si il n est pas executable, on le rend executable)
system ( "chmod +x $script_pretrait" ) if ( not - x $ script_pretrait ) ;
#lancement du script : - 1er argument = chemin absolu vers l executable Herezh
# - 2eme argument = nom du fichier .info
2017-06-01 11:36:52 +02:00
system ( "./$script_pretrait $hzchemin $fichier_test.info > $script_pretrait.log" ) ;
2017-01-04 18:52:58 +01:00
#affichage du contenu du fichier de redirection
system ( "cat $script_pretrait.log" ) ;
#verification du pretraitement (on s attend a trouver une chaine de la forme "resultat pretrait : STATUS [commentaires facultatifs]" dans le .log)
# rq : les [commentaires facultatifs] ne seront affiches que si le STATUS est ECHEC
my $ resu_pretrait = '' ;
my $ commentaire ;
open ( FIC , "<$script_pretrait.log" ) ;
while ( <FIC> ) {
next if ( not /^\s*resultat\s+pretrait\s*:\s*(\S+)/i ) ; #rq : recherche insensible a la casse
$ resu_pretrait = $ 1 ;
( my $ reste_chaine = $ _ ) =~ s/^\s*resultat\s+pretrait\s*:\s*\S+\s*// ;
chomp ( $ reste_chaine ) ;
$ commentaire = "(cause : $reste_chaine)" if ( length ( $ reste_chaine ) > 0 ) ;
last ;
}
close ( FIC ) ;
#verif du resultat (doit etre ECHEC ou OK)
( $ resu_pretrait eq 'OK' or $ resu_pretrait eq 'ECHEC' ) or do {
printRapport ( " -> ECHEC : resultat non conforme via le script $script_pretrait. Cause possible : la chaine \"resultat pretrait : ...\" 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 via le script $script_pretrait. Cause possible : la chaine \"resultat pretrait : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n" ;
last BOUCLE_TEST ;
} ;
if ( $ resu_pretrait eq 'ECHEC' ) {
printRapport ( " -> ECHEC : probleme dans l execution du script de pre-traitement (script : $script_pretrait)\n" ) ;
if ( defined $ commentaire ) {
printRapport ( " $commentaire\n\n" ) ;
}
last BOUCLE_TEST ;
}
} #if(-e $script_pretrait)
2015-04-14 21:36:00 +02:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# CONSTRUCTION DE LA COMMANDE HEREZH
2015-04-29 18:36:49 +02:00
# rq : en l absence d un fichier .argument, on considere qu il s agit d un calcul (-f fic.info) si le mot-cle dimension est repere dans le fichier .info
2015-04-14 21:36:00 +02:00
# 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 = "" ;
#################################################################################
2015-04-29 18:36:49 +02:00
#---cas d un fichier d arguments (la commande est construite via le contenu du fichier $fic_argument si il existe)
2015-04-14 21:36:00 +02:00
#################################################################################
2015-04-29 18:36:49 +02:00
if ( - e $ fic_argument ) {
open ( FIC , "<$fic_argument" ) ;
2015-04-14 21:36:00 +02:00
while ( <FIC> ) {
next if ( /^\s*\#/ ) ;
next if ( /^\s*$/ ) ;
chomp ;
$ cmd_HZ . = " $_" ;
}
close ( FIC ) ;
}
#################################################################################
2015-04-29 18:36:49 +02:00
#---cas general (pas de fichier .argument => calcul -f ou creation .info -n)
2015-04-14 21:36:00 +02:00
#################################################################################
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" ;
2015-04-16 18:14:34 +02:00
#suppression du fichier .maple (raison : si il y a erreur Herezh, il n y aura pas de .maple cree et donc il y aura un risque d utiliser un ancien .maple pour la comparaison)
system ( "rm -f $fichier_temp_maple" ) ;
2015-04-14 21:36:00 +02:00
#---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
2015-09-29 02:05:59 +02:00
unless ( not - e "$fichier_test.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 ) ;
2015-04-14 21:36:00 +02:00
}
}
##############################################################
#---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
2015-11-25 10:00:06 +01:00
system ( "rm -f $fichier_test.CVisu; cp $fichier_test.CVisu$no_test $fichier_test.CVisu" ) ;
2015-04-14 21:36:00 +02:00
#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
2015-09-29 02:05:59 +02:00
2015-04-14 21:36:00 +02:00
my $ status_calcul = lancement_commande ( $ hzchemin , $ cmd_HZ , "$fichier_test.log" , $ fic_commande ) ;
2015-04-22 17:18:47 +02:00
# - si le calcul a termine normalement (converge ou non) => $status_calcul = "ok"
# - si le calcul a conduit a un trop gros fichier de redirection => $status_calcul = "depassement taille maximum"
# - si il y a eu un probleme de redirection d affichage => $status_calcul = "probleme redirection affichage"
# - si le calcul ne s arretait pas alors qu il avait une activite cpu nulle => $status_calcul = "activite cpu nulle"
2015-04-14 21:36:00 +02:00
2016-03-24 14:36:54 +01:00
2016-09-26 00:54:25 +02:00
#################################################################################
#premiere verification selon status renvoye par la subroutine lancement_commande
#################################################################################
#---cas d une interruption volontaire (par exemple : Ctrl-c)
if ( $ ARRET_FORCE ) {
printRapport ( " -> ECHEC : ***INTERRUPTION PAR L UTILISATEUR***\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : INTERRUPTION PAR L UTILISATEUR\n" ;
last BOUCLE_TEST ;
}
#---cas d un calcul ayant conduit a un trop gros fichier de redirection
elsif ( $ 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 un calcul qui ne se lance pas
elsif ( $ status_calcul eq "probleme lancement calcul" ) {
printRapport ( " -> ECHEC : le calcul ne se lance pas\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul ne se lance pas\n" ;
last BOUCLE_TEST ;
}
#---cas d un arret a cause d une activite cpu nulle
elsif ( $ status_calcul eq "activite cpu nulle" ) {
printRapport ( " -> ECHEC : le calcul ne s arretait pas alors qu il avait une activite cpu nulle\n" ) ;
printRapport ( " Causes possibles :\n" ) ;
printRapport ( " - erreur dans la lecture de la mise en donnees (verifiez le .info)\n" ) ;
printRapport ( " - probleme de menu interactif (verifiez le .CVisu ou le fichier .commande si il existe)\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul ne s arretait pas alors qu il avait une activite cpu nulle\n" ;
print " Causes possibles :\n" ;
print " - erreur dans la lecture de la mise en donnees (verifiez le .info)\n" ;
print " - probleme de menu interactif (verifiez le .CVisu ou le fichier .commande si il existe)\n\n" ;
last BOUCLE_TEST ;
}
#---cas d un status autre que "ok" (typiquement un message d erreur)
elsif ( $ status_calcul ne 'ok' ) {
printRapport ( " -> ECHEC : le calcul a produit le message d erreur suivant : $status_calcul\n\n" ) ;
print "**Erreur Test $repertoire_test/.CVisu$no_test : le calcul a produit le message d erreur suivant : $status_calcul\n" ;
last BOUCLE_TEST ;
}
2016-03-24 14:36:54 +01:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# EVENTUEL POST-TRAITEMENT (si presence du fichier $script_posttrait)
#----------------------------------------------------------------------------------------------------
#####################################################################################################
if ( - e $ script_posttrait ) {
#verification des droits du script (doit etre executable. si il n est pas executable, on le rend executable)
system ( "chmod +x $script_posttrait" ) if ( not - x $ script_posttrait ) ;
#lancement du script : - 1er argument = chemin absolu vers l executable Herezh
# - 2eme argument = nom du fichier .info
# - 3eme argument = nom du fichier de redirection du calcul
2017-06-01 11:36:52 +02:00
system ( "./$script_posttrait $hzchemin $fichier_test.info $fichier_test.log > $script_posttrait.log" ) ;
2016-03-24 14:36:54 +01:00
#affichage du contenu du fichier de redirection
system ( "cat $script_posttrait.log" ) ;
2017-01-04 18:52:58 +01:00
#verification du post-traitement (on s attend a trouver une chaine de la forme "resultat posttrait : STATUS [commentaires facultatifs]" dans le .log)
# rq : les [commentaires facultatifs] ne seront affiches que si le STATUS est ECHEC
my $ resu_posttrait = '' ;
my $ commentaire ;
2016-03-24 14:36:54 +01:00
open ( FIC , "<$script_posttrait.log" ) ;
while ( <FIC> ) {
2017-01-04 18:52:58 +01:00
next if ( not /^\s*resultat\s+posttrait\s*:\s*(\S+)/i ) ; #rq : recherche insensible a la casse
$ resu_posttrait = $ 1 ;
( my $ reste_chaine = $ _ ) =~ s/^\s*resultat\s+posttrait\s*:\s*\S+\s*// ;
chomp ( $ reste_chaine ) ;
$ commentaire = "(cause : $reste_chaine)" if ( length ( $ reste_chaine ) > 0 ) ;
last ;
2016-03-24 14:36:54 +01:00
}
close ( FIC ) ;
2017-01-04 18:52:58 +01:00
#verif du resultat (doit etre ECHEC ou OK)
( $ resu_posttrait eq 'OK' or $ resu_posttrait eq 'ECHEC' ) or do {
printRapport ( " -> ECHEC : resultat non conforme via le script $script_posttrait. Cause possible : la chaine \"resultat posttrait : ...\" 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 via le script $script_posttrait. Cause possible : la chaine \"resultat posttrait : ...\" n a pas ete trouvee ou alors le resultat n etait ni OK, ni ECHEC\n" ;
last BOUCLE_TEST ;
} ;
if ( $ resu_posttrait eq 'ECHEC' ) {
printRapport ( " -> ECHEC : probleme dans l execution du script de post-traitement (script : $script_posttrait)\n" ) ;
if ( defined $ commentaire ) {
printRapport ( " $commentaire\n\n" ) ;
}
last BOUCLE_TEST ;
}
2016-03-24 14:36:54 +01:00
} #if(-e $script_posttrait)
2015-11-25 10:00:06 +01:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# SAISIE DU TEMPS CPU DANS LE FICHIER .log
#----------------------------------------------------------------------------------------------------
#####################################################################################################
#
#commentaires : pour rappel, le temps de calcul est fournie par la commande time
# on va afficher le temps CPU en un format plus lisible que celui fourni par time (i.e conversion en hh:mm:ss.sss)
# la commande time renvoie 4 informations :
# - temps cpu (un reel en secondes suivi de la lettre u)
# - temps systeme (un reel en secondes suivi de la lettre s)
# - temps reel (format variable selon sa taille : secondes, minutes:secondes ou heures:minutes:secondes)
# - pourcentage utilisation processeur (un reel suivi du caractere %)
# IMPORTANT : le "temps cpu" et le "temps systeme" sont a mettre en relation avec le "pourcentage utilisation processeur"
# il y a a peu pres la relation :
# "temps reel" = ("temps cpu" + "temps systeme")/"pourcentage utilisation processeur"
#
printRapport ( " -------------------------------------------------------\n" ) ;
my $ is_time_ok = 0 ; #indicateur de presence du resultat de la commande time
open ( Flog , "<$fichier_test.log" ) ;
while ( <Flog> ) {
next if ( not /($format_reel)u/ ) ;
my $ temps_cpu = $ 1 ;
next if ( not /($format_reel)s/ ) ;
my $ temps_systeme = $ 1 ;
next if ( not /($format_reel)\%/ ) ;
my $ pourcent_proc = $ 1 ;
next if ( not /((?:\d+:)?\d+:$format_reel)/ ) ;
my @ temps_reel = split ( /:/ , $ 1 ) ;
#commande time ok
$ is_time_ok = 1 ;
#conversion du "temps_cpu" (a mettre en relation avec le pourcentage processeur)
$ _ [ 0 ] = int ( $ temps_cpu / 3600 . ) ; #nb heures
$ _ [ 1 ] = int ( ( $ temps_cpu - $ _ [ 0 ] * 3600 . ) / 60 . ) ; #nb minutes
$ _ [ 2 ] = sprintf ( "%.3f" , $ temps_cpu - $ _ [ 0 ] * 3600 . - $ _ [ 1 ] * 60 . ) ; #secondes (avec les milliemes)
for ( my $ i = 0 ; $ i <= 2 ; $ i + + ) { $ _ [ $ i ] = "0$_[$i]" if ( $ _ [ $ i ] < 10 ) ; } #retouche cosmetique : rajout d un 0 davant le nombre si il n est constitue que de 1 seul digit
printRapport ( " | temps cpu : $_[0]:$_[1]:$_[2] (processeur : $pourcent_proc\%)\n" ) ;
#conversion du "temps systeme" (a mettre en relation avec le pourcentage processeur)
$ _ [ 0 ] = int ( $ temps_systeme / 3600 . ) ; #nb heures
$ _ [ 1 ] = int ( ( $ temps_systeme - $ _ [ 0 ] * 3600 . ) / 60 . ) ; #nb minutes
$ _ [ 2 ] = sprintf ( "%.3f" , $ temps_systeme - $ _ [ 0 ] * 3600 . - $ _ [ 1 ] * 60 . ) ; #secondes (avec les milliemes)
for ( my $ i = 0 ; $ i <= 2 ; $ i + + ) { $ _ [ $ i ] = "0$_[$i]" if ( $ _ [ $ i ] < 10 ) ; } #retouche cosmetique : rajout d un 0 davant le nombre si il n est constitue que de 1 seul digit
printRapport ( " | temps systeme : $_[0]:$_[1]:$_[2] (processeur : $pourcent_proc\%)\n" ) ;
#conversion en 2 etapes du "temps reel" qui n est pas au meme format que les 2 autres (et il faut gerer les cas ou il manque hh ou mm)
# 1) on commence par etablir sa duree en secondes
my $ temps_reel_en_secondes ;
#cas ou le "temps reel" n est que en secondes
if ( $# temps_reel == 0 ) { $ temps_reel_en_secondes = $ temps_reel [ 0 ] ; }
#cas ou le "temps reel" est au format minutes:secondes
elsif ( $# temps_reel == 1 ) { $ temps_reel_en_secondes = $ temps_reel [ 1 ] + 60 . * $ temps_reel [ 0 ] ; }
#cas ou le "temps reel" est au format heures:minutes:secondes
elsif ( $# temps_reel == 2 ) { $ temps_reel_en_secondes = $ temps_reel [ 2 ] + 60 . * $ temps_reel [ 1 ] + 3600 . * $ temps_reel [ 0 ] ; }
#autre cas (improbable) => on met 0
else { $ temps_reel_en_secondes = 0 ; }
# 2) maintenant, on traite la conversion comme vu precedemment
$ _ [ 0 ] = int ( $ temps_reel_en_secondes / 3600 . ) ; #nb heures
$ _ [ 1 ] = int ( ( $ temps_reel_en_secondes - $ _ [ 0 ] * 3600 . ) / 60 . ) ; #nb minutes
$ _ [ 2 ] = sprintf ( "%.2f" , $ temps_reel_en_secondes - $ _ [ 0 ] * 3600 . - $ _ [ 1 ] * 60 . ) ; #secondes (avec les centiemes)
for ( my $ i = 0 ; $ i <= 2 ; $ i + + ) { $ _ [ $ i ] = "0$_[$i]" if ( $ _ [ $ i ] < 10 ) ; } #retouche cosmetique : rajout d un 0 davant le nombre si il n est constitue que de 1 seul digit
printRapport ( " | temps reel : $_[0]:$_[1]:$_[2]\n" ) ;
}
close ( Flog ) ;
#cas ou le resultat de la commande time n a pas ete trouve dans le fichier .log (on ecrit juste un warning dans le rapport)
if ( not $ is_time_ok ) {
printRapport ( " (**Attention : impossible de saisir le temps de calcul)\n" ) ;
printRapport ( "\n" ) ;
}
printRapport ( " -------------------------------------------------------\n" ) ;
printRapport ( "\n" ) ;
2015-04-14 21:36:00 +02:00
#####################################################################################################
#----------------------------------------------------------------------------------------------------
# VERIFICATION DU 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" ) ;
2015-04-16 18:14:34 +02:00
print " \#----------------\n" ;
print " \# Debut de l affichage produit par le script $script_verif\n" ;
print " \#----------------\n" ;
2017-06-01 11:36:52 +02:00
system ( "./$script_verif $hzchemin $fichier_test.log $fichier_test.info | tee $script_verif.log" ) ;
2015-04-16 18:14:34 +02:00
print " \#----------------\n" ;
print " \# Fin de l affichage produit par le script $script_verif\n" ;
print " \#----------------\n" ;
2015-04-14 21:36:00 +02:00
2017-01-04 18:52:58 +01:00
#saisie du resultat (on s attend a trouver une chaine de la forme "resultat verification : STATUS [commentaires facultatifs]" dans le .log)
# rq : les [commentaires facultatifs] ne seront affiches que si le STATUS est ECHEC
2015-04-14 21:36:00 +02:00
my $ resu_verif = '' ;
2017-01-04 18:52:58 +01:00
my $ commentaire ;
2015-04-14 21:36:00 +02:00
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 ;
2016-10-12 10:09:31 +02:00
( my $ reste_chaine = $ _ ) =~ s/^\s*resultat\s+verification\s*:\s*\S+\s*// ;
chomp ( $ reste_chaine ) ;
2017-01-04 18:52:58 +01:00
$ commentaire = "(cause : $reste_chaine)" if ( length ( $ reste_chaine ) > 0 ) ;
2015-04-14 21:36:00 +02:00
last ;
}
close ( FIC ) ;
#verif du resultat (doit etre ECHEC ou OK)
( $ resu_verif eq 'OK' or $ resu_verif eq 'ECHEC' ) or do {
2016-10-12 10:09:31 +02:00
printRapport ( " -> resultat .verif : 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" ) ;
2015-04-14 21:36:00 +02:00
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 ;
} ;
2017-01-04 18:52:58 +01:00
printRapport ( " -> resultat .verif : $resu_verif (resultat fourni par le script de verification $script_verif)\n" ) ;
if ( $ resu_verif eq 'ECHEC' and defined $ commentaire ) {
printRapport ( " $commentaire\n" ) ;
}
printRapport ( "\n" ) ;
2015-04-14 21:36:00 +02:00
} #if(-e $script_verif)
2016-10-12 10:09:31 +02:00
2015-04-14 21:36:00 +02:00
#################################################################################
#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
#################################################################################
2016-10-12 10:09:31 +02:00
if ( - e "$fichier_temp_maple.ref$no_test" ) {
2015-04-14 21:36:00 +02:00
##############################################################
# 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 + + ) {
2018-03-15 14:14:01 +01:00
$ precisions_abolues [ $ i ] = $ PREC_ABSOLU_DEFAUT ;
$ precisions_relatives [ $ i ] = $ PREC_RELATIVE_DEFAUT ;
2015-04-14 21:36:00 +02:00
}
#---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 ) ;
}
2017-01-04 18:52:58 +01:00
2015-04-14 21:36:00 +02:00
##############################################################
# boucle de comparaison des donnees (test entre chaque valeur des listes @donnees_temp_maple et @donnees_ref_maple)
##############################################################
2015-11-25 10:00:06 +01:00
#Strategie :
# on va accumuler les affichages dans la variable $sortie_rapport et regarder si une des grandeurs est ECHEC
# si une des grandeurs est ECHEC => on affichera le contenu de la variable dans le rapport
# sinon, si toutes les grandeurs sont OK => on fera un affichage leger sur une ligne pour dire que toutes les grandeurs sont OK
my $ sortie_rapport = '' ; #variable tampon qui contiendra l integralite des affichages des resultats de comparaison maple
my $ is_grandeur_ECHEC = 0 ; #indicateur de presence d au moins un ECHEC
2015-04-14 21:36:00 +02:00
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 ;
2015-11-25 15:39:29 +01:00
#valeur a comparer (arrondie a 1.e-12 pour gerer le cas de nombres proches de 0)
my $ valeur_temp = sprintf ( "%.12f" , $ donnees_temp_maple [ $ i_valeur ] ) ; #calcul en cours
my $ valeur_ref = sprintf ( "%.12f" , $ donnees_ref_maple [ $ i_valeur ] ) ; #valeur de reference
2015-04-14 21:36:00 +02:00
#precisions
2015-11-25 15:39:29 +01:00
my $ precision_absolue = $ precisions_abolues [ $ i_valeur ] ; #*abs($valeur_ref);
2018-03-15 14:14:01 +01:00
my $ precision_relative = $ precisions_relatives [ $ i_valeur ] ;
2015-04-14 21:36:00 +02:00
2015-11-25 15:39:29 +01:00
#nombre de decimales des precisions (a titre cosmetique uniquement car c est pour afficher des valeurs arrondies dans le rapport de test)
my $ nb_decimales_prec_absolue = return_nb_decimales_first ( $ precision_absolue ) ;
my $ nb_decimales_prec_relative = return_nb_decimales_first ( $ precision_relative ) ;
2015-04-14 21:36:00 +02:00
#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 ) ;
2018-03-15 14:14:01 +01:00
#difference relative arrondie au nombre de decimale de la precision $precision_relative
my $ diff_relative ;
2015-04-14 21:36:00 +02:00
#-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 ) {
2018-03-15 14:14:01 +01:00
$ diff_relative = sprintf ( "%.${nb_decimales_prec_relative}f" , 0 . ) ;
2015-04-14 21:36:00 +02:00
}
#si $valeur_ref est nulle mais pas $valeur_temp, la comparaison relative est impossible
elsif ( $ valeur_ref == 0 ) {
2018-03-15 14:14:01 +01:00
$ diff_relative = "impossible car valeur de reference egale a 0" ;
2015-04-14 21:36:00 +02:00
}
#cas general : difference relative par rapport a $valeur_ref
else {
2018-03-15 14:14:01 +01:00
$ diff_relative = sprintf ( "%.${nb_decimales_prec_relative}f" , ( $ valeur_temp - $ valeur_ref ) / $ valeur_ref ) ;
2015-04-14 21:36:00 +02:00
}
2016-10-12 10:09:31 +02:00
$ sortie_rapport . = " -> grandeur testee : colonne \[$no_colonne_maple\]\n" ;
2015-04-14 21:36:00 +02:00
#############################
#comparaison absolue };
#############################
#---OK
2015-11-25 15:39:29 +01:00
if ( abs ( $ diff_absolue ) <= $ precision_absolue ) {
2016-10-12 10:09:31 +02:00
$ sortie_rapport . = " - comparaison absolue (precision : $precision_absolue) -> OK\n" ;
2015-04-14 21:36:00 +02:00
}
#---ECHEC
else {
2015-11-25 10:00:06 +01:00
$ is_grandeur_ECHEC = 1 ;
2016-10-12 10:09:31 +02:00
$ sortie_rapport . = " - comparaison absolue (precision : $precision_absolue) -> ECHEC\n" ;
$ sortie_rapport . = " -> Valeur = $valeur_temp\n" ;
$ sortie_rapport . = " -> Valeur reference = $valeur_ref\n" ;
$ sortie_rapport . = " -> Difference = $diff_absolue\n" ;
2015-04-14 21:36:00 +02:00
}
#############################
#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)
2018-03-15 14:14:01 +01:00
if ( $ diff_relative =~ /impossible/ ) {
2016-10-12 10:09:31 +02:00
$ sortie_rapport . = " - comparaison relative : impossible car valeur de reference egale a 0\n" ;
2015-04-14 21:36:00 +02:00
}
#---OK
2018-03-15 14:14:01 +01:00
elsif ( abs ( $ diff_relative ) <= $ precision_relative ) {
$ sortie_rapport . = " - comparaison relative (precision : $precision_relative) -> OK\n" ;
2015-04-14 21:36:00 +02:00
}
#---ECHEC
else {
2015-11-25 10:00:06 +01:00
$ is_grandeur_ECHEC = 1 ;
2018-03-15 14:14:01 +01:00
$ sortie_rapport . = " - comparaison relative (precision : $precision_relative) -> ECHEC\n" ;
2016-10-12 10:09:31 +02:00
$ sortie_rapport . = " -> Valeur = $valeur_temp\n" ;
$ sortie_rapport . = " -> Valeur reference = $valeur_ref\n" ;
2018-03-15 14:14:01 +01:00
$ sortie_rapport . = " -> Difference relative = $diff_relative\n" ;
2015-04-14 21:36:00 +02:00
}
2015-11-25 10:00:06 +01:00
$ sortie_rapport . = "\n" ;
2015-04-14 21:36:00 +02:00
} #for(my $i_valeur=0; $i_valeur<=$#donnees_temp_maple; $i_valeur++)
2015-11-25 10:00:06 +01:00
#si il y a au moins 1 ECHEC => ecriture de tout le contenu de $sortie_rapport
if ( $ is_grandeur_ECHEC ) {
2016-10-12 10:09:31 +02:00
printRapport ( " -> comparaison .maple : ECHEC\n\n$sortie_rapport" ) ;
2015-11-25 10:00:06 +01:00
}
#sinon, on signale que tout est OK
else {
2016-10-12 10:09:31 +02:00
printRapport ( " -> comparaison .maple : OK (pour toutes les grandeurs testees)\n\n" ) ;
2015-11-25 10:00:06 +01:00
}
2015-04-14 21:36:00 +02:00
close ( FSOR ) ;
} #elsif(-e $fichier_temp_maple)
#################################################################################
#cas sans verification
#################################################################################
2016-10-12 10:09:31 +02:00
#pas de verification si les conditions suivantes sont TOUTES remplies :
# - pas de fichier .verif
# - pas de fichier .maple.ref
if ( not ( - e $ script_verif ) and not ( - e "$fichier_temp_maple.ref$no_test" ) ) {
2015-04-14 21:36:00 +02:00
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" ) ;
2015-11-25 10:00:06 +01:00
#suppression des eventuels fichiers resultats (ATTENTION : ne pas supprimer les fichiers .BI et .PI pour permettre un RESTART au .CVisu suivant)
2015-04-14 21:36:00 +02:00
#--- 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
#####################################################################################################
2015-11-25 10:00:06 +01:00
#suppression repertoire de travail
system ( "rm -rf $repertoire_de_travail" ) ;
2015-04-14 21:36:00 +02:00
#####################################################################################################
# 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" ;
2016-03-11 17:47:39 +01:00
#####################################################################################################
# dans le cas du script verifier_exeHZ.pl => on signale la fin du test via le fichier $fic_communication
#####################################################################################################
system ( "echo FIN_TEST > $fic_communication" ) if ( defined $ fic_communication ) ;
2015-04-14 21:36:00 +02:00
##########################################################################
##########################################################################
##########################################################################
#
# 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 :
2015-04-22 17:18:47 +02:00
# - indicateur sur le status du calcul : "ok" => calcul a termine normalement (converge ou non)
# "depassement taille maximum" => calcul a conduit a un depassement du maximum autorise pour la taille du fichier de redirection
# "probleme redirection affichage" => la redirection de l affichage n a pas ete faite correctement (dans ce cas, probleme lie a la commande tee)
2015-10-01 00:56:53 +02:00
# "probleme lancement calcul" => le calcul ne s est pas lance
2015-04-22 17:18:47 +02:00
# "activite cpu nulle" => calcul ne s arretait pas alors qu il avait une activite cpu nulle
2016-09-26 00:54:25 +02:00
# "..." => divers messages d erreur produit par Herezh (voir variable @liste_message_erreur)
2018-03-15 20:00:21 +01:00
#
# Remarques :
# le calcul est lance via des liens symboliques vers l executable Herezh et sur le fichier .info (s il existe dans la commande $commande).
# Le nom de ces liens symboliques permet de reperer facilement les processus Herezh avec la commande ps. Et ce reperage de processus est l unique but
# de ces liens symboliques.
#
#
#
2015-04-14 21:36:00 +02:00
sub lancement_commande {
2015-04-22 17:18:47 +02:00
use IO::Handle ;
2015-04-14 21:36:00 +02:00
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
2015-11-25 10:00:06 +01:00
my $ lien_symbolique_HZ = 'testHZ' . int ( rand ( 99999999999 ) ) ;
2015-04-14 21:36:00 +02:00
#creation du lien symbolique
system ( "ln -s $hzchemin_original $lien_symbolique_HZ" ) ;
2018-03-15 20:00:21 +01:00
##############################################################
#creation d un lien symbolique vers le fichier .info (si il y en a un dans $commande)
# 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)
#
# rq 2 : a l issue du calcul, il faudra renommer les fichiers resultats car ils vont etre nommes par Herezh en fonction du nom du lien symbolique. Il faudra donc
# leur redonner un nom coherent avec le nom du .info d origine (voir en fin de cette subroutine au moment de l appel a la subroutine renommage_arborescence() )
##############################################################
my $ racine_lien_symbolique_finfo ;
my $ racine_finfo ;
if ( $ commande =~ /\.info/ ) {
my @ commandes = split ( /\s+/ , $ commande ) ;
foreach my $ cmd ( @ commandes ) {
next if ( not $ cmd =~ /^(\S+)\.info$/ ) ;
$ racine_finfo = $ 1 ;
2018-03-15 22:37:19 +01:00
2018-03-15 20:00:21 +01:00
$ racine_lien_symbolique_finfo = "$racine_finfo" . int ( rand ( 99999999999 ) ) ;
2018-03-15 22:37:19 +01:00
#creation du lien symbolique .info
2018-03-15 20:00:21 +01:00
system ( "ln -s $racine_finfo.info $racine_lien_symbolique_finfo.info" ) ;
2018-03-15 22:37:19 +01:00
# si un RESTART doit etre fait, il faut renommer les .BI et .PI
system ( "mv -f $racine_finfo.BI $racine_lien_symbolique_finfo.BI" ) if ( - e "$racine_finfo.BI" ) ;
#idem pour le .PI
system ( "mv -f $racine_finfo.PI $racine_lien_symbolique_finfo.PI" ) if ( - e "$racine_finfo.PI" ) ;
2018-03-15 20:00:21 +01:00
$ cmd = "$racine_lien_symbolique_finfo.info" ; #remplacement du nom .info par "$racine_lien_symbolique_finfo.info" dans @commandes
last ;
}
#si on a trouve un fichier .info, il faut :
# - reconstituer la commande $commande en prenant le lien symbolique pour le fichier .info
# - creer un .CVisu qui correspond au .info symbolique si un .CVisu existe
if ( defined "$racine_finfo.info" ) {
#on recree la commande avec le nouveau nom du fichier .info
$ commande = join ( ' ' , @ commandes ) ;
#on fait egalement un lien symbolique vers l eventuel .CVisu
my $ fCVisu = "$racine_finfo.CVisu" ;
if ( - e $ fCVisu ) {
system ( "ln -s $fCVisu $racine_lien_symbolique_finfo.CVisu" ) ;
}
}
}
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
#lancement du calcul Herezh dans un pipe
2015-04-14 21:36:00 +02:00
# rq : redirection de l affichage dans le fichier $fredir_tee
##############################################################
2018-03-15 22:37:19 +01:00
2017-06-01 11:36:52 +02:00
open ( PIPE , "|tcsh -c \"time ./$lien_symbolique_HZ $commande\" | tee $fredir_tee" ) ;
2015-04-22 17:18:47 +02:00
PIPE - > autoflush ( 1 ) ; #forcer a vider le tampon (methode autoflush du package IO::Handle)
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
#ecriture des reponses interactives si le fichier $fic_commande existe
if ( - e $ fic_commande ) {
open ( FIC , "<$fic_commande" ) ;
while ( <FIC> ) {
print PIPE ;
}
close ( FIC ) ;
}
2015-04-14 21:36:00 +02:00
##############################################################
#recuperation des pid de processus Herezh (dans la variable @HZpid)
# rq : pour pouvoir les tuer en cas de probleme
##############################################################
2015-04-22 17:18:47 +02:00
#saisie de la liste des processus sous la forme "pid %cpu commande" en ne gardant (grep) que les processus comportant la chaine $lien_symbolique_HZ pour l utilisateur courant $ENV{USER}
# et en ne gardant pas (grep -v) les processus contenant le mot grep
my @ processus = qx( ps -U $ENV{USER} -o pid,%cpu,command | grep $lien_symbolique_HZ | grep -v grep ) ;
# remarque : idealement, @processus ne contient qu un seul processus (celui du calcul) grace au filtrage grep
# mais si il en contient plus, ca ne posera pas de probleme car de toute facon, tous les processus contenant le mot $lien_symbolique_HZ
# peuvent etre tues sans perturber le reste de l activite de la machine
2015-04-14 21:36:00 +02:00
#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
2015-09-29 02:05:59 +02:00
# on en profite pour verifier que le calcul a bien ete lance (on refait la liste @HZpid comme vu ci-dessus si elle est vide)
# car dans ce cas, le fichier de redirection ne se creera jamais
2015-04-14 21:36:00 +02:00
##############################################################
2015-09-29 02:05:59 +02:00
my $ cpt_attente_lancement_commande = 0 ;
my $ cpt_attente_creation_log = 0 ;
while ( not - e $ fredir_tee ) {
#cas d un calcul pas encore lance
if ( $# HZpid == - 1 ) {
select ( undef , undef , undef , 0.001 ) ; #temps d attente d 1 milliseconde
@ processus = qx( ps -U $ENV{USER} -o pid,%cpu,command | grep $lien_symbolique_HZ | grep -v grep ) ;
foreach my $ processus ( @ processus ) {
next if ( not $ processus =~ /^\s*(\d+)/ ) ;
push ( @ HZpid , $ 1 ) ;
}
$ cpt_attente_lancement_commande + + ;
2015-04-14 21:36:00 +02:00
2015-09-29 02:05:59 +02:00
#on genere une erreur si la commande ne s est toujours pas lancee apres 2000 fois 1 milliseconde = 2 secondes
if ( $ cpt_attente_lancement_commande == 2000 ) {
#suppression des processus de calcul
2016-03-24 14:36:54 +01:00
kill ( "KILL" , @ HZpid ) ;
2015-09-29 02:05:59 +02:00
#suppression lien symbolique
system ( "rm -f $lien_symbolique_HZ" ) ;
2015-04-14 21:36:00 +02:00
2015-09-29 02:05:59 +02:00
return "probleme lancement calcul" ;
}
}
#cas d un calcul lance mais ou le fichier de redirection n existe pas encore
else {
select ( undef , undef , undef , 0.001 ) ; #temps d attente d 1 milliseconde
$ cpt_attente_creation_log + + ;
#on genere une erreur si le fichier de redirection n a toujours pas ete cree apres 2000 fois 1 milliseconde = 2 secondes
if ( $ cpt_attente_creation_log == 2000 ) {
#suppression des processus de calcul
2016-03-24 14:36:54 +01:00
kill ( "KILL" , @ HZpid ) ;
2015-09-29 02:05:59 +02:00
#suppression lien symbolique
system ( "rm -f $lien_symbolique_HZ" ) ;
return "probleme redirection affichage" ;
}
}
}
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
2015-10-01 00:56:53 +02:00
2015-04-22 17:18:47 +02:00
#
#...maintenant, on va lancer un processus fils pour surveiller le calcul. On provoque son arret force (kill -9) dans les cas suivants :
# 1) si la taille du fichier $fredir_tee depasse $TAILLE_MAX_FIC_REDIR octets
# 2) si le calcul a une activite cpu nulle mais ne s arrete pas
#
2016-03-24 14:36:54 +01:00
# -----------------------------------
# REMARQUE J. Troufflard 2016-03-21 :
# -----------------------------------
# | la variable @HZpid n est pas fiable pour tuer les processus. J ai remarque
# | qu un nouveau processus apparaissait parfois suite au fork() ci-dessous => my $PID_SURVEILLANCE = fork();
# | On recree donc la liste des processus a chaque tour de boucle pour
# | etre sur de bien tuer tous les processus avec kill("KILL", ...)
# | (variable : @process dans la boucle LOOP_SURVEILLANCE:while() )
# --------------------------------------------------------------------------------------------------------------
#
2015-04-22 17:18:47 +02:00
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
# surveillance en continu dans un processus fils :
# - de la taille du fichier de redirection
# - de l activite cpu du calcul
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
#la creation du fichier $fic_com_taille_max permettra d indiquer au processus pere que le fichier $fredir_tee a depasse la taille maximum autorisee $TAILLE_MAX_FIC_REDIR octets
my $ fic_com_taille_max = "$lien_symbolique_HZ.TAILLE_MAX_FIC_REDIR" ; system ( "rm -f $fic_com_taille_max" ) ;
#la creation du fichier $fic_com_activite_cpu permettra d indiquer au processus pere que les processus ont une activite nulle
my $ fic_com_activite_cpu = "$lien_symbolique_HZ.ACTIVITE_CPU" ; system ( "rm -f $fic_com_activite_cpu" ) ;
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
my $ PID_SURVEILLANCE = fork ( ) ;
2015-04-14 21:36:00 +02:00
#
#le bloc suivant ne concerne que le processus fils
2015-04-22 17:18:47 +02:00
if ( $ PID_SURVEILLANCE == 0 ) {
#compteur pour reperer si l activite cpu est nulle plusieurs fois d affilee ($nb_fois_cpu_nul_MAX fois)
my $ nb_fois_cpu_nul = 0 ;
my $ nb_fois_cpu_nul_MAX = 10 ;
LOOP_SURVEILLANCE:while ( ) {
2015-04-14 21:36:00 +02:00
#pause de 0.5 seconde
select ( undef , undef , undef , 0.5 ) ;
2015-04-22 17:18:47 +02:00
2016-03-24 14:36:54 +01:00
#liste des processus sous le format "pid %cpu commande" dont la commande contient le mot $lien_symbolique_HZ et pas le mot grep
my @ process = qx( ps -U $ENV{USER} -o pid,%cpu,command | grep $lien_symbolique_HZ | grep -v grep ) ;
2018-03-15 20:00:21 +01:00
#ajout des processus dont la commande contient le nom "$racine_lien_symbolique_finfo.info" (s il existe) et pas le mot grep
if ( defined $ racine_lien_symbolique_finfo ) {
my @ process_tmp = qx( ps -U $ENV{USER} -o pid,%cpu,command | grep $racine_lien_symbolique_finfo | grep -v grep ) ;
push ( @ process , @ process_tmp ) ;
}
2016-03-24 14:36:54 +01:00
#liste des pid correspondants
my @ pid_process = ( ) ;
foreach my $ process ( @ process ) {
next if ( not $ process =~ /^\s*(\d+)/ ) ;
push ( @ pid_process , $ 1 ) ;
}
2016-03-11 17:47:39 +01:00
##
## CAS D UN ARRET FORCE (par exemple Ctrl-c)
##
if ( $ ARRET_FORCE ) {
2016-03-24 14:36:54 +01:00
kill ( "KILL" , @ pid_process ) ;
2016-03-11 17:47:39 +01:00
last ;
}
2015-04-22 17:18:47 +02:00
##
## SURVEILLANCE DE LA TAILLE DU FICHIER
##
#taille actuelle du fichier de redirection
2015-04-14 21:36:00 +02:00
my $ taille_fichier = - s $ fredir_tee ;
2015-04-22 17:18:47 +02:00
#si la taille du fichier a depasse la limite => on cree le fichier de communication $fic_com_taille_max, on tue les processus de calcul et on sort de la boucle
2015-04-14 21:36:00 +02:00
if ( $ taille_fichier > $ TAILLE_MAX_FIC_REDIR ) {
2015-04-22 17:18:47 +02:00
open ( FCOM , ">$fic_com_taille_max" ) ;
close ( FCOM ) ;
2016-03-24 14:36:54 +01:00
kill ( "KILL" , @ pid_process ) ;
2015-04-22 17:18:47 +02:00
last ;
}
##
## SURVEILLANCE DE L ACTIVITE CPU
##
#on sort de la boucle si aucun processus ne tourne
last if ( $# process == - 1 ) ;
#liste des activites cpu
my @ activite_cpu = ( ) ;
foreach my $ process ( @ process ) {
2016-03-24 14:36:54 +01:00
my $ tmp_process = $ process ;
$ tmp_process =~ s/^\s*\d+// ; #suppresion pid en debut
next if ( not $ tmp_process =~ /^\s*\d/ ) ;
$ tmp_process =~ s/^\s+// ; #suppression espaces en debut
( $ tmp_process ) = split ( /\s+/ , $ tmp_process ) ; #separation suivant les espaces et on ne garde que le premier element retourne par split
$ tmp_process =~ s/,/./ ; #remplacement d une eventuelle virgule par un . dans le nombre reel representant l activite cpu
push ( @ activite_cpu , $ tmp_process ) ;
2015-04-22 17:18:47 +02:00
}
#si l un des processus a une activite non nulle, on en deduit que le calcul tourne encore => on remet a 0 le compteur $nb_fois_cpu_nul et on recommence la boucle
foreach my $ activite_cpu ( @ activite_cpu ) {
if ( $ activite_cpu > 0 ) {
$ nb_fois_cpu_nul = 0 ;
next LOOP_SURVEILLANCE ;
}
}
#sinon, on est dans le cas ou l activite cpu est nulle => on incremente le compteur
$ nb_fois_cpu_nul + + ;
#si le compteur est egal au max, on kill les processus, on cree le fichier de communication $fic_com_activite_cpu et on sort de la boucle
if ( $ nb_fois_cpu_nul == $ nb_fois_cpu_nul_MAX ) {
open ( FCOM , ">$fic_com_activite_cpu" ) ;
close ( FCOM ) ;
2016-03-24 14:36:54 +01:00
kill ( 'KILL' , @ pid_process ) ;
2015-04-14 21:36:00 +02:00
last ;
}
}
2015-04-22 17:18:47 +02:00
2015-04-14 21:36:00 +02:00
exit ;
2015-04-22 17:18:47 +02:00
} #fin du fils
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
#fermeture du pipe
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
close ( PIPE ) ;
2015-04-14 21:36:00 +02:00
2015-04-22 17:18:47 +02:00
#attente de la fin du processus fils de surveillance
waitpid ( $ PID_SURVEILLANCE , 0 ) ;
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
# etat du calcul
2015-04-14 21:36:00 +02:00
##############################################################
2015-04-22 17:18:47 +02:00
my $ status_calcul ;
2015-04-14 21:36:00 +02:00
2016-03-11 17:47:39 +01:00
#si il y a eu un arret force => status = arret force
if ( $ ARRET_FORCE ) {
$ status_calcul = "arret force" ;
}
2015-04-22 17:18:47 +02:00
#si le fichier $fic_com_taille_max existe, cela veut dire qu il y a eu un depassement de la taille maximum autorisee
# => status => depassement taille maximum
2016-03-11 17:47:39 +01:00
elsif ( - e $ fic_com_taille_max ) {
2015-04-22 17:18:47 +02:00
$ status_calcul = 'depassement taille maximum' ;
2015-04-14 21:36:00 +02:00
}
2015-04-22 17:18:47 +02:00
#si le fichier $fic_com_activite_cpu existe, cela veut dire qu il y a eu un arret a cause d un calcul qui attend sans activite
# => status => activite cpu nulle
elsif ( - e $ fic_com_activite_cpu ) {
$ status_calcul = 'activite cpu nulle' ;
}
#sinon ca veut dire que le calcul Herezh s est arrete normalement (qu il ait converge ou non)
2016-09-26 00:54:25 +02:00
# en ce cas, on regarde si certains messages d erreur apparaissent dans le .log
#
# si aucun message d erreur => status calcul = ok
#
# sinon, on renvoie le message d erreur => status calcul = ... non du message ...
#
2015-04-14 21:36:00 +02:00
else {
2016-09-26 00:54:25 +02:00
#liste des messages d erreur repertories :
# Remarques : 1) il s agit de repertorier les messages d erreur fatal. C'est-a-dire des problemes
# plutot en lien avec l informatique, et pas la mecanique.
# 2) ATTENTION a bien recopier le message d erreur fourni par Herezh (les majuscules et le nombre d espaces comptent!!!)
2016-09-27 16:24:16 +02:00
my @ liste_message_erreur = ( 'Segmentation fault' ,
'erreur \(.+\) detectee' #ce motif permet de reconnaitre la chaine 'erreur ' suivie d un message quelconque entre parentheses, suivi de la chaine ' detectee'
) ;
2016-09-26 00:54:25 +02:00
#initilisation du status a "ok"
2015-04-22 17:18:47 +02:00
$ status_calcul = 'ok' ;
2016-09-26 00:54:25 +02:00
#recherche d un eventuel message d erreur
open ( my $ Hlocal , "<$fredir_tee" ) ;
LECTURE_FIC:while ( <$Hlocal> ) {
foreach my $ message ( @ liste_message_erreur ) {
2016-09-27 16:24:16 +02:00
if ( /($message)/ ) {
$ status_calcul = $ 1 ;
2016-09-26 00:54:25 +02:00
last LECTURE_FIC ;
}
}
}
close ( $ Hlocal ) ;
2015-04-14 21:36:00 +02:00
}
2015-04-22 17:18:47 +02:00
#suppression des eventuels fichiers de communication
system ( "rm -f $fic_com_taille_max $fic_com_activite_cpu" ) ;
2018-03-15 20:00:21 +01:00
#suppression du lien symbolique commande Herezh
2015-04-22 17:18:47 +02:00
system ( "rm -f $lien_symbolique_HZ" ) ;
2018-03-15 20:00:21 +01:00
#suppression du lien symbolique .info et .CVisu eventuels
if ( defined $ racine_lien_symbolique_finfo ) {
system ( "rm -f $racine_lien_symbolique_finfo.info $racine_lien_symbolique_finfo.CVisu" ) ;
}
#tous les fichiers crees par Herezh ont un nom qui ont la meme racine que $racine_lien_symbolique_finfo
# => il faut les renommer (notamment on aura besoin du .BI et .PI si on doit faire des restarts pour les prochaines .CVisu[i], du _princ.maple pour la comparaison et meme des fichiers _Gmsh un jour peut-etre)
renommage_arborescence ( '.' , $ racine_lien_symbolique_finfo , $ racine_finfo ) ;
2015-04-22 17:18:47 +02:00
return $ status_calcul ;
2015-04-14 21:36:00 +02:00
} #sub lancement_commande
2018-03-15 20:00:21 +01:00
#####################################################################################################
#subroutine qui renomme les fichiers et repertoires en fouillant dans toute une arborescence depuis un repertoire de depart
#####################################################################################################
# en entree :
# - repertoire de depart
# - chaine de caracteres a trouver dans les noms de fichiers initiaux
# - chaine de caracteres qui doit remplacer la chaine initiale
#
# en sortie :
# pas de sortie (les fichiers et repertoires ont ete renommes)
#
sub renommage_arborescence {
my $ rep = shift ;
my $ chaine_ini = shift ;
my $ chaine_fin = shift ;
#astuce : inversion des motifs de reconnaissance pour faire une substitution en commencant par la fin
my $ inversion_chaine_ini = join ( '' , reverse split ( // , $ chaine_ini ) ) ;
my $ inversion_chaine_fin = join ( '' , reverse split ( // , $ chaine_fin ) ) ;
#d abord on renomme les fichiers
my @ liste_fichiers ;
my @ liste_tmp = glob ( "$rep/*$chaine_ini*" ) ;
while ( $# liste_tmp > - 1 ) {
my $ elt = shift ( @ liste_tmp ) ;
if ( - d $ elt ) {
push ( @ liste_tmp , glob ( "$elt/*$chaine_ini*" ) ) ;
}
else {
push ( @ liste_fichiers , $ elt ) ;
}
}
foreach my $ fic ( @ liste_fichiers ) {
my $ inversion_nom = join ( '' , reverse split ( // , $ fic ) ) ;
( my $ nouveau_nom = $ inversion_nom ) =~ s/$inversion_chaine_ini/$inversion_chaine_fin/ ;
$ nouveau_nom = join ( '' , reverse split ( // , $ nouveau_nom ) ) ;
system ( "mv -f $fic $nouveau_nom" ) ;
}
#ensuite on renomme les repertoires
my @ liste_repertoires ;
@ liste_tmp = glob ( "$rep/*$chaine_ini*" ) ;
while ( $# liste_tmp > - 1 ) {
my $ elt = shift ( @ liste_tmp ) ;
if ( - d $ elt ) {
push ( @ liste_repertoires , $ elt ) ;
push ( @ liste_tmp , glob ( "$elt/*$chaine_ini*" ) ) ;
}
}
#on commence par ceux de la fin (ce sont les plus loins dans l arborescence)
foreach my $ rep ( reverse @ liste_repertoires ) {
my $ inversion_nom = join ( '' , reverse split ( // , $ rep ) ) ;
( my $ nouveau_nom = $ inversion_nom ) =~ s/$inversion_chaine_ini/$inversion_chaine_fin/ ;
$ nouveau_nom = join ( '' , reverse split ( // , $ nouveau_nom ) ) ;
system ( "mv -f $rep $nouveau_nom" ) ;
}
}
2015-04-14 21:36:00 +02:00
#####################################################################################################
#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 :
2015-10-01 00:56:53 +02:00
# - chemin absolu de la commande (0 si commande introuvable)
2015-04-14 21:36:00 +02:00
#
sub verif_commande {
my $ cmd = shift ; #nom de la commande
2015-04-29 18:36:49 +02:00
#cas d un chemin absolu ou relatif (si la commande commence par . ou /. Par exemple : ./HZpp ../HZppfast ou /Users/dupont/bin/HZppfast)
if ( $ cmd =~ /^\./ or $ cmd =~ /^\// ) {
2015-04-16 18:14:34 +02:00
#on passe la commande en chemin absolu
$ cmd = rel2abs ( $ cmd ) ;
return $ cmd ;
2015-04-14 21:36:00 +02:00
}
2015-04-16 18:14:34 +02:00
#sinon on regarde dans la variable environnement $PATH
2015-04-14 21:36:00 +02:00
foreach my $ path ( split ( /\s*:\s*/ , $ ENV { PATH } ) ) {
2015-04-16 18:14:34 +02:00
if ( - x "$path/$cmd" ) {
#on s assure que c est un chemin absolu
$ cmd = rel2abs ( "$path/$cmd" ) ;
return $ cmd ;
}
2015-04-14 21:36:00 +02:00
}
2015-04-29 18:36:49 +02:00
#on regarde a nouveau si la commande est en chemin absolu ou relatif
# (cas d une commande qui ne commence pas par . ou / et qui n est pas dans les PATH. Par exemple : rep/HZpp)
if ( - x $ cmd ) {
#on passe la commande en chemin absolu
$ cmd = rel2abs ( $ cmd ) ;
return $ cmd ;
}
2015-04-14 21:36:00 +02:00
#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
#####################################################################################################
2015-11-25 15:39:29 +01:00
#subroutine qui renvoie le nombre de decimales necessaire pour atteindre la premiere decimale non nulle d un reel
2015-04-14 21:36:00 +02:00
#####################################################################################################
2015-11-25 15:39:29 +01:00
##
2015-04-14 21:36:00 +02:00
# en entree :
# - un reel
#
# en sortie :
# - nombre de decimales
#
2015-11-25 15:39:29 +01:00
sub return_nb_decimales_first {
2015-04-14 21:36:00 +02:00
my $ nombre = shift ;
2015-11-25 15:39:29 +01:00
$ nombre = abs ( $ nombre ) ;
2015-04-14 21:36:00 +02:00
2015-11-25 15:39:29 +01:00
$ nombre = $ nombre - int ( $ nombre ) ; #suppression de la partie entiere
return 0 if ( $ nombre == 0 ) ; #gestion du cas $nombre == entier
2015-04-14 21:36:00 +02:00
2015-11-25 15:39:29 +01:00
#on multiplie par 10 le nombre jusqu a ce qu il devienne superieur ou egal a 1
# => On compte 1 decimale pour chaque multiplication par 10
my $ nb_decimales = 0 ;
while ( ) {
last if ( $ nombre >= 1 ) ;
$ nombre *= 10 ;
$ nb_decimales + + ;
}
2015-04-14 21:36:00 +02:00
return $ nb_decimales ;
2015-11-25 15:39:29 +01:00
} #sub return_nb_decimales_first
2015-04-14 21:36:00 +02:00
#####################################################################################################
#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
