#!/usr/bin/env perl use strict; use warnings; 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) # - 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) # ##################################################################################################### ##################################### ##################################### # # 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-1";#precision pour la comparaison relative (en pourcent) #2015-11-25 : changement precision relative de 1e-3 en 1e-1 (0.001% c etait un peu trop severe) ##################################### ##################################### # # 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 beaucoup trop de chose 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 (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) ########################### Variables executable Herezh ########################### my $exeHZ; ###---Executable Herezh my $hzchemin; ###---path vers l executable Herezh ########################### 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) ########################################################################## ########################################################################## ########################################################################## # # (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"; print " -> 3] (facultatif) pid du processus verifier_exeHZ.pl qui a lance ce script\n"; exit; } #nom du repertoire du test $repertoire_test = shift(@ARGV); #nom de l executable Herezh $exeHZ = shift(@ARGV); #pid du processus verifier_exeHZ.pl qui a lance ce script (argument facultatif) $pid_verifier_exeHZ = shift(@ARGV) if($#ARGV > -1); #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; }; #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; }; } ########################################################################## ########################################################################## ########################################################################## # # (FIN) RECUPERATION ET VERIFICATION DES ARGUMENTS DU SCRIPT # ########################################################################## ########################################################################## ########################################################################## ########################################################################## ########################################################################## ########################################################################## # # (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) # ########################################################################## ########################################################################## ########################################################################## ########################################################################## ########################################################################## ########################################################################## # # (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) # ########################################################################## ########################################################################## ########################################################################## #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; }; 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 @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) # rq : l execution des tests se fait dans le repertoire # de travail $repertoire_de_travail afin de ne jamais modifier le repertoire d origine # ########################################################################## ########################################################################## ########################################################################## #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 print " Deplacement dans le repertoire temporaire de travail : $repertoire_de_travail\n"; chdir $repertoire_de_travail; ################################################ #(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("\n\n$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 arguments .argument # - fichier pre-traitement .pretrait # - fichier post-traitement .posttrait #---------------------------------------------------------------------------------------------------- ##################################################################################################### 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_argument = ""; $fic_argument = "$fichier_test.argument$no_test" if(-e "$fichier_test.argument$no_test"); 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"); ##################################################################################################### #---------------------------------------------------------------------------------------------------- # CONSTRUCTION DE LA COMMANDE HEREZH # 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 # 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 arguments (la commande est construite via le contenu du fichier $fic_argument si il existe) ################################################################################# if(-e $fic_argument) { open(FIC, "<$fic_argument"); while() { next if(/^\s*\#/); next if(/^\s*$/); chomp; $cmd_HZ .= " $_"; } close(FIC); } ################################################################################# #---cas general (pas de fichier .argument => 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"; #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"); #---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() { 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 unless(not -e "$fichier_test.PI") { open(FIC, "<$fichier_test.PI"); while() { 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+$//; ##################################################################################################### #---------------------------------------------------------------------------------------------------- # 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 system("$script_pretrait $hzchemin $fichier_test.info > $script_pretrait.log"); #affichage du contenu du fichier de redirection system("cat $script_pretrait.log"); #verification du pretraitement (l indicateur de reussite/echec est : "resultat pretrait : OK (ou ECHEC)" ) my $resultat_pretrait = ''; open(FIC, "<$script_pretrait.log"); while() { if(/^\s*resultat\s+pretrait\s*:\s*OK/) { $resultat_pretrait = 'OK'; } elsif(/^\s*resultat\s+pretrait\s*:\s*ECHEC/) { printRapport(" -> ECHEC : probleme dans l execution du script de pre-traitement (script : $script_pretrait)\n\n"); print "**Erreur Test $repertoire_test/.CVisu$no_test : probleme dans l execution du script de pre-traitement (script : $script_pretrait)\n\n"; last BOUCLE_TEST; } } close(FIC); ($resultat_pretrait eq 'OK') or do { printRapport(" -> ECHEC : le script de pre-traitement ($script_pretrait) n a pas affiche d indicateur de reussite\n\n"); print "**Erreur Test $repertoire_test/.CVisu$no_test : le script de pre-traitement ($script_pretrait) n a pas affiche d indicateur de reussite\n\n"; last BOUCLE_TEST; }; }#if(-e $script_pretrait) ##################################################################################################### #---------------------------------------------------------------------------------------------------- # LANCEMENT DU CALCUL #---------------------------------------------------------------------------------------------------- ##################################################################################################### #recopie du .CVisu[$no_test] vers .CVisu system("rm -f $fichier_test.CVisu; cp $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 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" ################################################################################# #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; } ##################################################################################################### #---------------------------------------------------------------------------------------------------- # 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 system("$script_posttrait $hzchemin $fichier_test.info $fichier_test.log > $script_posttrait.log"); #affichage du contenu du fichier de redirection system("cat $script_posttrait.log"); #verification du post-traitement (l indicateur de reussite/echec est : "resultat posttrait : OK (ou ECHEC)" ) my $resultat_posttrait = ''; open(FIC, "<$script_posttrait.log"); while() { if(/^\s*resultat\s+posttrait\s*:\s*OK/) { $resultat_posttrait = 'OK'; } elsif(/^\s*resultat\s+posttrait\s*:\s*ECHEC/) { printRapport(" -> ECHEC : probleme dans l execution du script de post-traitement (script : $script_posttrait)\n\n"); print "**Erreur Test $repertoire_test/.CVisu$no_test : probleme dans l execution du script de post-traitement (script : $script_posttrait)\n\n"; last BOUCLE_TEST; } } close(FIC); ($resultat_posttrait eq 'OK') or do { printRapport(" -> ECHEC : le script de post-traitement ($script_posttrait) n a pas affiche d indicateur de reussite\n\n"); print "**Erreur Test $repertoire_test/.CVisu$no_test : le script de post-traitement ($script_posttrait) n a pas affiche d indicateur de reussite\n\n"; last BOUCLE_TEST; }; }#if(-e $script_posttrait) ##################################################################################################### #---------------------------------------------------------------------------------------------------- # 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() { 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"); ##################################################################################################### #---------------------------------------------------------------------------------------------------- # 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"); print " \#----------------\n"; print " \# Debut de l affichage produit par le script $script_verif\n"; print " \#----------------\n"; system("$script_verif $hzchemin $fichier_test.log $fichier_test.info | tee $script_verif.log"); print " \#----------------\n"; print " \# Fin de l affichage produit par le script $script_verif\n"; print " \#----------------\n"; #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() { 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() { 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() { 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() { 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) ############################################################## #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 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 (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 #precisions my $precision_absolue = $precisions_abolues[$i_valeur];#*abs($valeur_ref); my $precision_relative = $precisions_relatives[$i_valeur]; #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); #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); } $sortie_rapport .= " -> grandeur testee : colonne \[$no_colonne_maple\]\n"; ############################# #comparaison absolue }; ############################# #---OK if(abs($diff_absolue) <= $precision_absolue) { $sortie_rapport .= " - comparaison absolue (precision : $precision_absolue) -> OK\n"; } #---ECHEC else { $is_grandeur_ECHEC = 1; $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"; } ############################# #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/) { $sortie_rapport .= " - comparaison relative : impossible car valeur de reference egale a 0\n"; } #---OK elsif(abs($diff_relative_pourcent) <= $precision_relative) { $sortie_rapport .= " - comparaison relative (precision : $precision_relative\%) -> OK\n"; } #---ECHEC else { $is_grandeur_ECHEC = 1; $sortie_rapport .= " - comparaison relative (precision : $precision_relative\%) -> ECHEC\n"; $sortie_rapport .= " -> Valeur = $valeur_temp\n"; $sortie_rapport .= " -> Valeur reference = $valeur_ref\n"; $sortie_rapport .= " -> Difference relative = $diff_relative_pourcent\%\n"; } $sortie_rapport .= "\n"; }#for(my $i_valeur=0; $i_valeur<=$#donnees_temp_maple; $i_valeur++) #si il y a au moins 1 ECHEC => ecriture de tout le contenu de $sortie_rapport if($is_grandeur_ECHEC) { printRapport($sortie_rapport); } #sinon, on signale que tout est OK else { printRapport(" -> pour toutes les grandeurs testees : OK\n\n"); } 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 au .CVisu suivant) #--- 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 ##################################################################################################### #suppression repertoire de travail system("rm -rf $repertoire_de_travail"); ##################################################################################################### # 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"; ##################################################################################################### # 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); ########################################################################## ########################################################################## ########################################################################## # # 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" => 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) # "probleme lancement calcul" => le calcul ne s est pas lance # "activite cpu nulle" => calcul ne s arretait pas alors qu il avait une activite cpu nulle # "..." => divers messages d erreur produit par Herezh (voir variable @liste_message_erreur) sub lancement_commande { use IO::Handle; 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 = 'testHZ'.int(rand(99999999999)); #creation du lien symbolique system("ln -s $hzchemin_original $lien_symbolique_HZ"); ############################################################## #lancement du calcul Herezh dans un pipe # rq : redirection de l affichage dans le fichier $fredir_tee ############################################################## open(PIPE, "|tcsh -c \"time $lien_symbolique_HZ $commande\" | tee $fredir_tee"); PIPE->autoflush(1);#forcer a vider le tampon (methode autoflush du package IO::Handle) #ecriture des reponses interactives si le fichier $fic_commande existe if(-e $fic_commande) { open(FIC, "<$fic_commande"); while() { print PIPE; } close(FIC); } ############################################################## #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 %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 #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 # 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 ############################################################## 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++; #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 kill("KILL", @HZpid); #suppression lien symbolique system("rm -f $lien_symbolique_HZ"); 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 kill("KILL", @HZpid); #suppression lien symbolique system("rm -f $lien_symbolique_HZ"); return "probleme redirection affichage"; } } } # #...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 # # ----------------------------------- # 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() ) # -------------------------------------------------------------------------------------------------------------- # ############################################################## # surveillance en continu dans un processus fils : # - de la taille du fichier de redirection # - de l activite cpu du calcul ############################################################## #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"); my $PID_SURVEILLANCE = fork(); # #le bloc suivant ne concerne que le processus fils 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() { #pause de 0.5 seconde select(undef, undef, undef, 0.5); #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); #liste des pid correspondants my @pid_process = (); foreach my $process (@process) { next if(not $process =~ /^\s*(\d+)/); push(@pid_process, $1); } ## ## CAS D UN ARRET FORCE (par exemple Ctrl-c) ## if($ARRET_FORCE) { kill("KILL", @pid_process); last; } ## ## SURVEILLANCE DE LA TAILLE DU FICHIER ## #taille actuelle du fichier de redirection my $taille_fichier = -s $fredir_tee; #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 if($taille_fichier > $TAILLE_MAX_FIC_REDIR) { open(FCOM, ">$fic_com_taille_max"); close(FCOM); kill("KILL", @pid_process); 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) { 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); } #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); kill('KILL', @pid_process); last; } } exit; }#fin du fils ############################################################## #fermeture du pipe ############################################################## close(PIPE); #attente de la fin du processus fils de surveillance waitpid($PID_SURVEILLANCE, 0); ############################################################## # etat du calcul ############################################################## my $status_calcul; #si il y a eu un arret force => status = arret force if($ARRET_FORCE) { $status_calcul = "arret force"; } #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 elsif(-e $fic_com_taille_max) { $status_calcul = 'depassement taille maximum'; } #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) # 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 ... # else { #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!!!) 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' ); #initilisation du status a "ok" $status_calcul = 'ok'; #recherche d un eventuel message d erreur open(my $Hlocal, "<$fredir_tee"); LECTURE_FIC:while(<$Hlocal>) { foreach my $message (@liste_message_erreur) { if(/($message)/) { $status_calcul = $1; last LECTURE_FIC; } } } close($Hlocal); } #suppression des eventuels fichiers de communication system("rm -f $fic_com_taille_max $fic_com_activite_cpu"); #suppression du lien symbolique system("rm -f $lien_symbolique_HZ"); return $status_calcul; }#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 absolu de la commande (0 si commande introuvable) # sub verif_commande { my $cmd = shift;#nom de la commande #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 =~ /^\//) { #on passe la commande en chemin absolu $cmd = rel2abs($cmd); return $cmd; } #sinon on regarde dans la variable environnement $PATH foreach my $path (split(/\s*:\s*/, $ENV{PATH})) { if(-x "$path/$cmd") { #on s assure que c est un chemin absolu $cmd = rel2abs("$path/$cmd"); return $cmd; } } #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; } #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() { 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 necessaire pour atteindre la premiere decimale non nulle d un reel ##################################################################################################### ## # en entree : # - un reel # # en sortie : # - nombre de decimales # sub return_nb_decimales_first { my $nombre = shift; $nombre = abs($nombre); $nombre = $nombre - int($nombre);#suppression de la partie entiere return 0 if($nombre == 0);#gestion du cas $nombre == entier #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++; } return $nb_decimales; }#sub return_nb_decimales_first ##################################################################################################### #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() { #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() 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() { #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