411 lines
16 KiB
Perl
411 lines
16 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
#!/usr/local/bin/perl
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use English;
|
||
|
|
use File::Basename;
|
||
|
|
use File::Spec::Functions qw(splitpath rel2abs);#($volume, $rep, $fic) = splitpath($path); $absolute_path = rel2abs($relative_path)
|
||
|
|
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*)?';
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# RECUPERATION ET VERIFICATION DES ARGUMENTS ET OPTIONS 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 < 0) {
|
||
|
|
afficher_ligne_tirets('print');
|
||
|
|
print "Script $NOM_PROG \n";
|
||
|
|
afficher_ligne_tirets('print');
|
||
|
|
print " Description :\n";
|
||
|
|
print " Lancement de la batterie de verification Herezh\n";
|
||
|
|
print " Par defaut, ce script lance tous les tests disponibles dans l arborescence.\n";
|
||
|
|
print " Un certain nombre d options sont proposees pour modifier le fonctionnement.\n";
|
||
|
|
print "\n";
|
||
|
|
print " Pour les tests rapides : le rapport sera contenu dans Rapport/rapport_Test_R.txt\n";
|
||
|
|
print " Pour les tests longs : le rapport sera contenu dans Rapport/rapport_Test_L.txt\n";
|
||
|
|
print " En cas d option -rpt : le rapport sera contenu dans Rapport/rapport_test_debugECHEC.txt\n";
|
||
|
|
print "\n";
|
||
|
|
print " Usage : $NOM_PROG [-R] [-L] [-rpt fic_rapport] exeHZ\n";
|
||
|
|
print "\n";
|
||
|
|
print " Argument obligatoire :\n";
|
||
|
|
print " exeHZ : nom de l executable Herezh\n";
|
||
|
|
print "\n";
|
||
|
|
print " Options :\n";
|
||
|
|
print " -R : ne lancer que les tests rapides (Test_R)\n";
|
||
|
|
print "\n";
|
||
|
|
print " -L : ne lancer que les tests longs (Test_L)\n";
|
||
|
|
print "\n";
|
||
|
|
print " -rpt fic_rapport : seuls les tests presents dans le fichier de rapport\n";
|
||
|
|
print " fic_rapport et ayant un indicateur ECHEC seront lances\n";
|
||
|
|
print "\n";
|
||
|
|
print " Remarque :\n";
|
||
|
|
print " contrairement aux commandes linux classiques, les options de ce script\n";
|
||
|
|
print " peuvent etre placees n importe ou. Par exemple, les commandes suivantes\n";
|
||
|
|
print " fonctionnent de maniere equivalente :\n";
|
||
|
|
print " > $NOM_PROG -R HZppfast_Vn-1\n";
|
||
|
|
print " > $NOM_PROG HZppfast_Vn-1 -R\n";
|
||
|
|
afficher_ligne_tirets('print');
|
||
|
|
print "\n";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
# recuperation des arguments et options
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
my $exeHZ;#argument obligatoire : nom de l executable Herezh
|
||
|
|
my $is_opt_R = 0;#indicateur de l option -R (0 par defaut; si egal 1 => lancement des tests rapides Test_R uniquement)
|
||
|
|
my $is_opt_L = 0;#indicateur de l option -L (0 par defaut; si egal 1 => lancement des tests longs Test_L uniquement)
|
||
|
|
my $fic_rapport;#option -rpt : nom du fichier de rapport a exploiter (non defini par defaut; si utilisation de l option -rpt => lancement uniquement des tests ayant echoue de ce rapport (ECHEC)
|
||
|
|
|
||
|
|
#On vide le contenu de @ARGV en conservant les arguments obligatoires dans @args et traiter les options au cas par cas
|
||
|
|
my $opt;
|
||
|
|
my @args;
|
||
|
|
while($#ARGV != -1) {
|
||
|
|
$opt = shift(@ARGV);
|
||
|
|
|
||
|
|
#option -R
|
||
|
|
if($opt eq '-R') {
|
||
|
|
$is_opt_R = 1;
|
||
|
|
}
|
||
|
|
#option -L
|
||
|
|
elsif($opt eq '-L') {
|
||
|
|
$is_opt_L = 1;
|
||
|
|
}
|
||
|
|
#option -rpt
|
||
|
|
elsif($opt eq '-rpt') {
|
||
|
|
($#ARGV != -1) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : l option -rpt necessite de specifier un nom de fichier rapport...\n\n";
|
||
|
|
$fic_rapport = shift(@ARGV);
|
||
|
|
#verif de l existence du fichier rapport
|
||
|
|
(-e $fic_rapport) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier rapport $fic_rapport introuvable...\n\n";
|
||
|
|
}
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
#note aux developpeurs : AJOUTER ICI LE TRAITEMENT D UNE NOUVELLE OPTION
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#cas d une option inconnue (on l ignore)
|
||
|
|
elsif($opt =~ /^-/) {
|
||
|
|
warn "Attention (prog:$NOM_PROG) : l option $opt est inconnue (et ignoree)...\n";
|
||
|
|
warn "(taper entree pour continuer...)\n";
|
||
|
|
<STDIN>;
|
||
|
|
}
|
||
|
|
#sinon on enregistre l argument dans @args
|
||
|
|
else {
|
||
|
|
push(@args, $opt);
|
||
|
|
}
|
||
|
|
}#while($#ARGV != -1)
|
||
|
|
|
||
|
|
#a ce stade, les arguments restants sont dans @args
|
||
|
|
($#args >= 0) or die "\nErreur (prog:$NOM_PROG) : arguments manquants ($NOM_PROG -h pour afficher l aide)...\n\n";
|
||
|
|
#premier argument obligatoire : nom de l executable Herezh
|
||
|
|
$exeHZ = shift(@args);
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
#note aux developpeurs : AJOUTER ICI DE NOUVELLES VERIF EN LIEN AVEC UNE NOUVELLE OPTION OU UN NOUVEL ARGUMENT
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
|
||
|
|
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
# verification des arguments et options
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
#validite de l executable Herezh
|
||
|
|
(verif_commande($exeHZ) ne '0') or die "\nErreur (prog:$NOM_PROG) : commande Herezh $exeHZ introuvable ou non executable...\n\n";
|
||
|
|
|
||
|
|
#option -R et -L mutuellement exclusives (si les 2 ont ete utilisees => erreur)
|
||
|
|
if($is_opt_R and $is_opt_L) {
|
||
|
|
die "\nErreur (prog:$NOM_PROG, opt:-R/-L) : interdiction d utiliser les options -R et -L en meme temps...\n\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
#si option -rpt : verif de l existence et de la validite du fichier rapport $fic_rapport
|
||
|
|
if(defined $fic_rapport) {
|
||
|
|
#existence
|
||
|
|
(-e $fic_rapport) or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier $fic_rapport introuvable...\n\n";
|
||
|
|
|
||
|
|
#validite (par une heuristique : est valide si on y trouve la chaine "RAPPORT DE TEST", sensible a la casse)
|
||
|
|
my $fichier_valide = 0;
|
||
|
|
open(FIC, "<$fic_rapport");
|
||
|
|
while(<FIC>) {next if(not /RAPPORT DE TEST/); $fichier_valide = 1; last;}
|
||
|
|
close(FIC);
|
||
|
|
$fichier_valide or die "\nErreur (prog:$NOM_PROG, opt:-rpt) : fichier $fic_rapport existe mais n est pas un fichier de rapport genere par le script $NOM_PROG...\n\n";
|
||
|
|
}
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
#note aux developpeurs : AJOUTER ICI DE NOUVELLES VERIF EN LIEN AVEC UNE NOUVELLE OPTION OU UN NOUVEL ARGUMENT
|
||
|
|
#* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# LANCEMENT DES TESTS
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
#verification prealable de la presence du repertoire Rapport
|
||
|
|
# > si existe deja mais est un fichier => arret avec message d erreur
|
||
|
|
if(-f "./Rapport") {
|
||
|
|
die "\nErreur (prog:$NOM_PROG) : la presence d un repertoire de nom Rapport est necessaire mais le repertoire contient deja un fichier de nom Rapport...\n\n";
|
||
|
|
}
|
||
|
|
# > si absent => on le cree
|
||
|
|
mkdir "./Rapport" if(not -e "./Rapport");
|
||
|
|
|
||
|
|
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
# option -rpt => lancement uniquement des tests ayant echoue du rapport $fic_rapport (et sortie du programme)
|
||
|
|
#--------------------------------------------------------------------------
|
||
|
|
my @LISTE_TESTS_ECHEC;
|
||
|
|
if(defined $fic_rapport) {
|
||
|
|
open(FIC, "<$fic_rapport");
|
||
|
|
my $is_test_ECHEC;
|
||
|
|
my $nom_repertoire_test;
|
||
|
|
while(<FIC>) {
|
||
|
|
#si c est une ligne finissant par .CVisu[no], alors cette ligne contient un nom de repertoire de test
|
||
|
|
if(/^\s*(.+).CVisu\d+/) {
|
||
|
|
$nom_repertoire_test = $1;#on actualise le nom de repertoire de test courant
|
||
|
|
$is_test_ECHEC = 0;#on reset l indicateur d echec
|
||
|
|
|
||
|
|
#petite retouche cosmetique => suppression d eventuels / en fin de nom de repertoire
|
||
|
|
$nom_repertoire_test =~ s/\/+$//;
|
||
|
|
}
|
||
|
|
#si le mot ECHEC est trouve => on enregistre le repertoire (sauf si ca a deja ete fait precedemment)
|
||
|
|
elsif(/ECHEC/) {
|
||
|
|
push(@LISTE_TESTS_ECHEC, $nom_repertoire_test);
|
||
|
|
#dans la ligne suivante, on evite d enregistrer plusieurs fois un meme repertoire
|
||
|
|
pop(@LISTE_TESTS_ECHEC) if($#LISTE_TESTS_ECHEC >= 1 and $LISTE_TESTS_ECHEC[-1] eq $LISTE_TESTS_ECHEC[-2]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
close(FIC);
|
||
|
|
##print "$_\n" for @LISTE_TESTS_ECHEC; exit;
|
||
|
|
|
||
|
|
#si il n y a aucun test ECHEC dans @LISTE_TESTS_ECHEC => tant mieux! on affiche la bonne nouvelle et on exit
|
||
|
|
if($#LISTE_TESTS_ECHEC == -1) {
|
||
|
|
print "\n";
|
||
|
|
print "Aucun test ECHEC n a ete trouve dans le fichier $fic_rapport ...\n\n";
|
||
|
|
print " - arret -\n";
|
||
|
|
exit;
|
||
|
|
}
|
||
|
|
|
||
|
|
#sinon => lancement des tests
|
||
|
|
else {
|
||
|
|
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
|
||
|
|
system("mv -f Rapport/rapport_test_debugECHEC.txt Rapport/rapport_test_debugECHEC_OLD.txt");
|
||
|
|
system("mv -f Rapport/Liste_Tests_debugECHEC.txt Rapport/Liste_Tests_debugECHEC.txt");
|
||
|
|
|
||
|
|
#creation du rapport temporaire
|
||
|
|
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
|
||
|
|
|
||
|
|
#liste des tests
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_ECHEC) {
|
||
|
|
system("echo $rep_test >> Rapport/Liste_Tests_debugECHEC.txt");
|
||
|
|
}
|
||
|
|
|
||
|
|
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire)
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_ECHEC) {
|
||
|
|
system("./Perl/test.pl $rep_test $exeHZ");
|
||
|
|
}
|
||
|
|
|
||
|
|
#creation du fichier rapport final
|
||
|
|
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_debugECHEC.txt");
|
||
|
|
#affichage du rapport
|
||
|
|
system("nedit Rapport/rapport_test_debugECHEC.txt &");
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
#on arrete le script
|
||
|
|
exit;
|
||
|
|
|
||
|
|
}#fin option -rpt
|
||
|
|
|
||
|
|
|
||
|
|
#--------------------
|
||
|
|
#lancement des tests rapides (sauf en cas d option -L)
|
||
|
|
#--------------------
|
||
|
|
unless($is_opt_L) {
|
||
|
|
#recherche des tests Test_R dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
|
||
|
|
my @LISTE_TESTS_R = map {chomp; $_} qx(find . -name "Test_R*" -type d);
|
||
|
|
|
||
|
|
#si il n y a aucun test dans @LISTE_TESTS_R => on le signale
|
||
|
|
if($#LISTE_TESTS_R == -1) {
|
||
|
|
print "\n";
|
||
|
|
print "Aucun test rapide Test_R n a ete trouve...\n\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
#sinon => lancement des tests
|
||
|
|
else {
|
||
|
|
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
|
||
|
|
system("mv -f Rapport/rapport_test_R.txt Rapport/rapport_test_R_OLD.txt");
|
||
|
|
system("mv -f Rapport/Liste_Tests_R.txt Rapport/Liste_Tests_R.txt");
|
||
|
|
|
||
|
|
#creation du rapport temporaire
|
||
|
|
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
|
||
|
|
|
||
|
|
#liste des tests
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_R) {
|
||
|
|
system("echo $rep_test >> Rapport/Liste_Tests_R.txt");
|
||
|
|
}
|
||
|
|
|
||
|
|
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire)
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_R) {
|
||
|
|
system("./Perl/test.pl $rep_test $exeHZ");
|
||
|
|
}
|
||
|
|
|
||
|
|
#creation du fichier rapport final
|
||
|
|
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_R.txt");
|
||
|
|
#affichage du rapport
|
||
|
|
system("nedit Rapport/rapport_test_R.txt &");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#--------------------
|
||
|
|
#lancement des tests longs (sauf en cas d option -R)
|
||
|
|
#--------------------
|
||
|
|
unless($is_opt_R) {
|
||
|
|
#recherche des tests Test_L dans l arborescence (utilisation de find et suppression de chaque retour a la ligne avec chomp)
|
||
|
|
my @LISTE_TESTS_L = map {chomp; $_} qx(find . -name "Test_L*" -type d);
|
||
|
|
|
||
|
|
#si il n y a aucun test dans @LISTE_TESTS_L => on le signale
|
||
|
|
if($#LISTE_TESTS_L == -1) {
|
||
|
|
print "\n";
|
||
|
|
print "Aucun test long Test_L n a ete trouve...\n\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
#sinon => lancement des tests
|
||
|
|
else {
|
||
|
|
#renommage d un eventuel rapport precedent en _OLD (et la liste des tests associee)
|
||
|
|
system("mv -f Rapport/rapport_test_L.txt Rapport/rapport_test_L_OLD.txt");
|
||
|
|
system("mv -f Rapport/Liste_Tests_L.txt Rapport/Liste_Tests_L.txt");
|
||
|
|
|
||
|
|
#creation du rapport temporaire
|
||
|
|
system("./Perl/genere_rapport.pl Rapport/rapport_test.txt $exeHZ");
|
||
|
|
|
||
|
|
#liste des tests
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_L) {
|
||
|
|
system("echo $rep_test >> Rapport/Liste_Tests_L.txt");
|
||
|
|
}
|
||
|
|
|
||
|
|
#lancement des tests (dont le resultat s ecrit dans le rapport temporaire)
|
||
|
|
foreach my $rep_test (@LISTE_TESTS_L) {
|
||
|
|
system("./Perl/test.pl $rep_test $exeHZ");
|
||
|
|
}
|
||
|
|
|
||
|
|
#creation du fichier rapport final
|
||
|
|
system("mv -f Rapport/rapport_test.txt Rapport/rapport_test_L.txt");
|
||
|
|
#affichage du rapport
|
||
|
|
system("nedit Rapport/rapport_test_L.txt &");
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
#
|
||
|
|
# SUBROUTINES
|
||
|
|
#
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
##########################################################################
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#subroutine permettant d ecrire une ligne de tirets de la largeur du terminal
|
||
|
|
#####################################################################################################
|
||
|
|
#
|
||
|
|
# en entree :
|
||
|
|
# - print ou warn (suivant que l on souhaite afficher avec print (donc vers STDOUT) ou warn (donc vers STDERR)
|
||
|
|
#
|
||
|
|
sub afficher_ligne_tirets {
|
||
|
|
use Term::ReadKey;
|
||
|
|
my $nb_char_largeur_terminal = ( GetTerminalSize() )[0];#largeur du terminal en nombre de caracteres (via package Term::ReadKey)
|
||
|
|
|
||
|
|
my $funct_disp = shift;
|
||
|
|
|
||
|
|
|
||
|
|
my $ligne_tirets = '';
|
||
|
|
$ligne_tirets .= '-' for(1 .. $nb_char_largeur_terminal);
|
||
|
|
|
||
|
|
print "$ligne_tirets\n" if($funct_disp eq 'print');
|
||
|
|
warn "$ligne_tirets\n" if($funct_disp eq 'warn');
|
||
|
|
}#sub afficher_ligne_tirets
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
#####################################################################################################
|
||
|
|
#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 aboslu 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
|