source: PSPA/madxPSPA/testing/MadTest.pl @ 430

Last change on this file since 430 was 430, checked in by touze, 11 years ago

import madx-5.01.00
File size: 32.7 KB
Line 
1#!/usr/bin/perl
2
3# now supports a specific $debugMode to carry-out tests of a single target.
4# sample invocation: MadTest.pl ./MadCvsExtract/madX debug=match
5# In this case, HTML file becomes test_debug.html instead of test.htm.
6
7# input: directory name in which madx and madxp are present
8# output: a hierachy of directories to hold the tests' inputs and outputs
9# at the same time an HTML document is created and moved to the web folder
10
11# Still to do :
12# (1) expand call-tree till the leafs
13# (2) accomodate for different directory structures
14# (3) allow for files loading from different directories in the call-tree
15# (4) check potential troubles with namespace restricted to target name
16# (5) ideally HTML formatting should be moved out of the code, relying on XML, XSLT and CSS instead
17
18use MIME::Lite; # to send e-mail
19
20open REPORT_FILE, ">MadTest_Report.txt";
21
22$startTime = localtime;
23
24my $path = $ENV{'PATH'};
25my $newPath = $path . ":."; # can invoke local commands from MAD-X script
26$ENV{'PATH'}=$newPath;
27
28
29
30print REPORT_FILE "MadTest.pl report from $startTime\n";
31
32$testReport = ""; # will be stored into an HTML document
33
34$pwd = `pwd`;
35chop $pwd;
36$localRootDir = $pwd;
37
38# for Makefile_develop and Makefile_nag, stderr is redirected
39my $stderrFile = "stderr_redirected";
40
41my $debugMode;          # select a specific target and writes summary HTML file
42                        # to test_debug.htm instead of test.htm
43my $debugTarget;        # meaningful iff $debugMode is set to 1
44               
45if ( $#ARGV < 0 ) {
46        print "expect at least 1 argument: (1) MAD executable directory [(2) debug:<target>]  EXIT!\n" ;
47        exit ;
48} else {
49        if ($#ARGV == 1) {
50                # second parameter for debug-mode
51                my $option = @ARGV[1];
52                if ($option =~ /^debug=(\w+)/){
53                        $debugMode = 1;
54                        $debugTarget = $1;
55                        print "debug mode set for target '$debugTarget'\n";
56                } else {
57               
58                        print "the second optional argument '$option' should be of the form:";
59                        print "debug=<target>\n";
60                        print "EXIT!\n";
61                        exit;
62                }
63        }
64
65        $madDir = @ARGV[0];
66        # check specified directory indeed contains executable
67        $existsMadx = `ls $madDir/madx | wc -l`;
68        if ($existsMadx == 0) {
69                print REPORT_FILE "Madx missing in specified directory => exit!\n";
70                exit;
71        }
72        $existsMadxp = `ls $madDir/madxp | wc -l`;
73        if ($existsMadxp == 0){
74                print REPORT_FILE "Madxp missing in specified directory => exit!\n";
75                exit;
76        }
77        # expand the full path
78        $_ = $madDir;
79        if (/^.\/([\w\d_\-\/.]+)/) {
80                # local path specified
81                $madDir = $localRootDir . "/" . $1;
82        } else { 
83                # full path already given
84        }
85
86        # remove last "/" if any
87        $_ = $madDir;
88        if (/\/$/) { chop $madDir;  } # $ for end anchoring of the string
89
90
91}
92
93
94# checkout reference examples from the CVS
95my $rmRes = `rm -rf ./madX-examples`;
96
97if ($debugMode ==0){
98        # default: we retrieve all the CVS
99        print REPORT_FILE "extract the complete CVS repository containing examples\n";
100        my $checkoutRes = `cvs -d :gserver:isscvs.cern.ch:/local/reps/madx-examples checkout madX-examples`;
101        print REPORT_FILE $checkoutRes;
102} else {
103        print REPORT_FILE "extract only the CVS repository containing specific example";
104        print REPORT_FILE " $debugTarget\n";
105        # extract only the $debugTarget from the CVS
106        my $checkoutRes = `cvs -d :gserver:isscvs.cern.ch:/local/reps/madx-examples checkout madX-examples/REF/$debugTarget`;
107        print REPORT_FILE $checkoutRes;
108}
109
110# $samplesRootDir = '/afs/cern.ch/user/f/frs/public_html/mad-X_examples';
111
112$samplesRootDir = "$localRootDir/madX-examples/REF";
113
114
115$htmlRootDir = '/afs/cern.ch/user/n/nougaret/www/mad';
116
117if ($debugMode == 0) {
118        $htmlFile = "$htmlRootDir/test.htm"; # for the time being
119} else {
120        $htmlFile = "$htmlRootDir/test_debug.htm"; # for the time being
121}
122       
123@targetDirs = `ls $samplesRootDir`;
124
125# search all test examples' directories
126# (only a subset of them will be processed by the automated test, as specified in a separate XML document)
127
128# in future version, should grow the call-graph from the list of source mad files provided in the XML file
129
130# not instead of being performed beforehand on all possible files, this dependency analysis should only be
131# carried-out on the actual target directories...
132
133# build the call-graph
134TARGET_DIR: foreach $targetDir (@targetDirs) {
135
136chop $targetDir;
137
138if ($debugMode ==1) {
139        if ($targetDir ne $debugTarget){
140                next TARGET_DIR;
141        }
142}
143
144
145print REPORT_FILE "target = '$targetDir'\n";
146
147chdir("$samplesRootDir/$targetDir");
148@subdirectories =`ls -d */`; # returns directories only (with '/' suffix)
149
150@alldirectories = ('./',@subdirectories);
151foreach $dir (@alldirectories) {
152        chop $dir; # end-of-line
153        chop $dir; # /
154        $pwd = `pwd`; # for print below
155        print REPORT_FILE "process directory $dir in $pwd\n";
156        if ($dir eq "test") { next; } # Very specific case: twiss/test directory causes multiple key error in call-graph
157        chdir("$samplesRootDir/$targetDir/$dir"); # go to subdir to open files with getListOfDependantFiles()
158        @files = `ls`;
159        foreach $file(@files) {
160        chop $file;
161        print REPORT_FILE "process $file"; 
162        $dependentFileList = getListOfDependantFiles($file);
163        # avoid name clash by prefixing
164        $fileKey = $targetDir . "/" . $file;
165        if ($dependencyList{$fileKey} ne "") {
166                # actually no trouble if the entry is the same
167                if ($dependencyList{$fileKey} eq $dependentFileList) {
168                print REPORT_FILE "WARNING: multiple entry $fileKey in call-graph\n";
169                $testReport .= "</p><font color=\"#FFCCBB\">WARNING: multiple entry $fileKey in call-graph</font></p>\n";
170
171                } else {
172                $testReport .= "</p><font color=\"#FFBBBB\">ERROR: multiple incompatible entry $fileKey in call-graph</font></p>\n";
173                print REPORT_FILE "ERROR: multiple incompatible entry $fileKey in call-graph\n";
174                print REPORT_FILE "previous entry = '$dependencyList{$fileKey}'\n";
175                print REPORT_FILE "new entry = $dependentFileList\n";
176                }
177        } # let's make sure
178       
179        $dependencyList{$fileKey}=$dependentFileList; # comma-separated list of files that depend on key
180        if ($dependencyList{$fileKey} ne "") {
181                print REPORT_FILE " -> calls $dependencyList{$fileKey}\n";
182        } else {
183                print REPORT_FILE " -> calls no other file\n";
184        }           
185        }
186        chdir("$samplesRootDir/$targetDir/$dir");
187}
188chdir($localRootDir); # back to local root dir
189
190}
191
192@makefiles = ('Makefile_develop','Makefile_nag','Makefile'); # Makefile must be last
193# because we need to have collected the results of the two previous makefiles in order
194# to prepare the final web-page, which is only created for Makefile ...
195
196# hierarchy to accomodate the local copy of the tests
197`rm -rf $localRootDir/TESTING`; # cleanup
198mkdir("$localRootDir/TESTING", 0777);
199
200foreach $makefile (@makefiles) { # repeat for Makefile_develop, Makefile_nag, Makefile
201
202# back to the initial directory
203chdir $localRootDir;
204
205my $regressionTest;
206if ($makefile eq "Makefile") {
207        $regressionTest = 1;
208} else {
209        $regressionTest = 0;
210}
211
212
213$localTestDir = "$localRootDir/TESTING/$makefile"; # separate work dirs for the 3 makefiles...
214mkdir($localTestDir, 0777);
215
216# following executables have been prepared by MadBuid.pl
217$madxLink = $madDir . "/madx_$makefile";
218$madxpLink = $madDir . "/madxp_$makefile";
219print REPORT_FILE "madxLink is $madxLink\n";
220print REPORT_FILE "madxpLink is $madxpLink\n";
221
222
223
224@targets = `xsltproc --stringparam what list_targets ProcessScenario.xsl TestScenario.xml`; # all target functionalities
225
226TARGET: foreach $target (@targets) {
227chop $target;
228
229$outcome{$target} = "success"; # by default, nobody will receive an e-mail about this target
230
231if ($debugMode ==1){
232        if ($target ne $debugTarget) {
233                next TARGET;
234        }
235}
236
237print REPORT_FILE "--- testing $target\n";
238
239        if ($regressionTest) {
240        $testReport .= "<table width=\"75%\" border=\"0\">\n";
241        $testReport .= "<tr class='test_target'><td colspan=\"2\"><div align=\"center\"><strong>$target</strong></div></td></tr>\n";
242        }
243
244chdir($localRootDir); # top of the hierarchy
245
246$targetDir = "$localTestDir/$target";
247mkdir($targetDir, 0777) or die "fail to create directory $targetDir\n";
248
249@tests = `xsltproc --stringparam what list_tests --stringparam target $target ProcessScenario.xsl TestScenario.xml`;
250
251
252chdir("$localTestDir/$target") or die "fail to chdir to $localTestDir/$target\n"; # after processing stylessheets
253
254# populate the local test directory with the input file as well as with all the files it depends from
255
256$autonumber = 0;
257foreach $test (@tests) {
258
259        $autonumber++;
260        chop $test;
261        $command = $test;
262        print REPORT_FILE "command='$command'\n";       
263       
264        # retreive the subdirectory relocation if any (specific subdirs are specified in the XML)
265        $sourceSubDir = ""; # by default
266        $_ = $command;
267        if(/subdirectory=([\w_\-\.\d]+)/){
268        $sourceSubDir = $1;
269        }
270
271        # retrieve the 'input file' name with a regular expression
272        $_ = $command;
273        /<[\s\t]+([\w\.\-_\d]+)[\s\t]+>/;
274        $infilename = $1;
275        print REPORT_FILE "the input file name is: $infilename\n";
276       
277        if ($sourceSubDir eq "" ) {
278        $testCaseDir = "test_" . $autonumber;
279        } else {
280        $testCaseDir = "test_" . $autonumber . "_" . $sourceSubDir; 
281        # keep the same name for the local test dir under 'target' as in the reference
282        # and the files will need to be copied from location with the $testSubDir prefix later-on...
283        }
284
285        # before executing the command, make sure we remove
286        # the optional subdirectory information which shows up after the comma
287        # in case the source test directory contains a subdirectory structure...
288        my $executableCommand;
289        if ($sourceSubDir eq "") {
290        $executableCommand = $command;
291        } else {
292        $_ = $command;
293        s/,[\s\t]*[\w\d.\-_=]+//g;
294        $executableCommand = $_;
295        }
296
297        if ($regressionTest) {
298                my $key = $target . "_" . $testCaseDir;
299                $testReport .= "<tr class='test_case'><td width=\"80%\">$testCaseDir: $executableCommand</td><td width=\"20%\"><table width=\"100%\" style=\"text-align: center\"><tr>$dev{$key} $nag{$key}</tr></table></td></tr>\n"; 
300                # above sets column width for the whole table
301        }
302
303
304        mkdir("$localTestDir/$target/$testCaseDir",0777) or die "fail to create directory $testCaseDir\n";
305        chdir("$localTestDir/$target/$testCaseDir") or die "fail to chdir to $localTestDir/$target/$testCaseDir\n";
306
307        # copy the input file that corresponds to this specific test case
308        if ($sourceSubDir eq "") {
309                `cp $samplesRootDir/$target/$infilename .`;
310        } else {
311                `cp $samplesRootDir/$target/$sourceSubDir/$infilename .`;
312        }
313       
314        $key = "$target/$infilename";
315
316        # now copy additional input files for the test, according to the dependency information retreived above
317        @inputs = split /,/, $dependencyList{"$target/$infilename"}; # prefixed with $target to avoid name clashes
318
319        # now grow the @input list by expanding the dependency and by adding the root node
320
321        # partial treatment: only look for files calling files under the same directory
322        my $reccursionLevels =2;
323
324        for ($i=0;$i<$reccursionLevels;$i++){
325        foreach $input (@inputs){
326                if ($dependencyList{"$target/$input"} ne "") 
327                {
328                my @secondLevelInputs = split /,/, $dependencyList{"$target/$input"};
329                # or third etc... level according to reccursion level...
330                foreach $secondLevelInput (@secondLevelInputs){
331                        if (/..\/([\w\d\-_\.\/]+)/) { 
332                        # file located in a directory with path starting above
333                        # currently handled differently by code appearing downthere
334                        # => do nothing for time-being
335                        # (incomplete: should also handle any tree structure)
336                        } else {
337                        print REPORT_FILE "Found $secondLevelInput called by $testCaseDir/$input and to be copied locally\n";
338                        # actually, should only add to the list if not already present
339                        my $existsInput = 0;
340                        INPUT_LOOP: foreach $existingInput (@inputs) {
341                                if ($secondLevelInput eq $existingInput) {
342                                $existsInput = 1;
343                                next INPUT_LOOP; 
344                                }
345                        }
346                        if ($existsInput ==0) {
347                                @inputs = (@inputs, $secondLevelInput);
348                        }
349                        } 
350                }
351                }
352        } # grow list of inputs at one level
353        }  # end growing the list of inputs that can be moved to the same input directory
354
355        @inputs = ($infilename, @inputs); # add the root inputfile
356
357
358        my @inputSubdirectories = (); # list of input subdirectories under the workdir in which MAD is invoked
359        # these subdirectories will later be moved under "inputs" instead of "outputs". In most cases this
360        # list is empty, but not for targets 'error' and 'twiss' for instance.
361
362
363        # copyping inputs and dependent files locally
364        foreach $input (@inputs) {
365        print REPORT_FILE "Input is $input\n";
366        $_ = $input;
367        # SPECIFIC CASE: files that must be stored in a locally replicated hierarchy
368        # considering the MAD call instructions mention a relative path...
369        # note later-on should also accomodate for situations were the included files
370        # are below, down the hierarchy... At this stage should re-implement path handling
371        if (/\.\.\/([\w\d\-_\.\/]+)/) { # ../dir/file or ../file formats
372                my $term = $1;
373                if (/(\.\.\/[\w\d\-_]+)\/([\w\d-_\.]+)/) { # ../dir/file format only
374                # file to be called is located up the hierarchy
375                # in which case we need to reflect the directory tree structure
376                # by creating directories if necessary
377                $dependencyDir = $1;
378                $dependencyFile = $2;
379                } else {
380                $dependencyDir = '..';
381                $dependencyFile = $term;
382                }
383                # print REPORT_FILE "Found dependency file '$dependencyFile' under '$dependencyDir'\n";         
384                $existsDir = `ls -d $dependencyDir | wc -l`;
385                # print REPORT_FILE "existsDir now equals $existsDir\n";
386                if ($existsDir == 1) {
387                print REPORT_FILE "dependency directory '$dependencyDir' already exists\n";
388                # simply copy the file
389                if  ($sourceSubDir eq "") {     
390                        `cp $samplesRootDir/$target/$dependencyDir/$dependencyFile ./$dependencyDir`;
391                } else {
392                        `cp $samplesRootDir/$target/$sourceSubDir/$dependencyDir/$dependencyFile ./$dependencyDir`; # should merge the two with '.' for $sourceSubDir
393                }
394
395                } else {
396#                   print REPORT_FILE "dependency directory '$dependencyDir' will be created\n";
397                # first create the directory, then copy the file
398                mkdir($dependencyDir,0777);
399                if ($sourceSubDir eq "") {
400                        `cp $samplesRootDir/$target/$dependencyDir/$dependencyFile ./$dependencyDir`;
401                } else {
402                        `cp $samplesRootDir/$target/$sourceSubDir/$dependencyDir/$dependencyFile ./$dependencyDir`; # should merge the two with '.' for $sourceSubDir
403
404                }
405                }
406
407
408                @secondLevelInputs = split /,/, $dependencyList{"$target/$dependencyFile"}; 
409                # prefixed with $target to avoid name clashes (may be too coarse!)
410                foreach $secondLevelInput (@secondLevelInputs) {
411                print REPORT_FILE "Second-level copy of $secondLevelInput\n";
412                $_ = $secondLevelInput;
413                if (/\.\.\/([\w\d\-_\.\/]+)/) { # ../dir/file or ../file formats
414                        my $term;
415                        if (/(..\/[\w\d\-_]+)\/([\w\d-_\.]+)/) { # ../dir/file format only
416                        $secondDependencyDir = $1;
417                        $secondDependencyFile = $2;
418                        } else {
419                        $secondDependencyDir = '..';
420                        $secondDependencyFile = my $term;
421                        }
422
423                        $existsSecondDir = `ls -d $dependencyDir/$secondDependencyDir | wc -l`;
424                        if ($existsSecondDir) {
425                        print REPORT_FILE "dependency second directory '$dependencyDir/$secondDependencyDir' already exists\n";
426                        # simply copy the file
427                        if  ($sourceSubDir eq "") {
428                                `cp $samplesRootDir/$target/$dependencyDir/$secondDependencyDir/$secondDependencyFile ./$dependencyDir/$secondDependencyDir`;
429                        } else {
430                                # current focus
431                                `cp $samplesRootDir/$target/$sourceSubDir/$dependencyDir/$secondDependencyDir/$secondDependencyFile ./$dependencyDir/$secondDependencyDir`; # should merge the two with '.' for $sourceSubDir
432                                print REPORT_FILE "now copying second-level $samplesRootDir/$target/$sourceSubDir/$dependencyDir/$secondDependencyDir/$secondDependencyFile into ./$dependencyDir/$secondDependencyDir\n";
433                        }
434                        } else {
435                        print REPORT_FILE "Not ready yet to handle creation of secondary dir/n";
436                        $testReport .= "ERROR: ($makefile) Not ready yet to handle creation of second-level dir\n";
437                        }
438                } else {
439                        # the second-level related file is located under the same directory
440                        if ($sourceSubDir eq "") {
441                        `cp $samplesRootDir/$target/$dependencyDir/secondLevelInput ./$dependencyDir`;
442                        } else {
443                        `cp $samplesRootDir/$target/$sourceSubDir/$dependencyDir/$secondLevelInput ./$dependencyDir`;
444                        }                   }
445
446                } # second level
447       
448        } 
449        else {
450
451                # --- below to handle the specific case of twiss lhc.madx -> temp contents seem to be cleaned-up from .mad files...
452                if ($input =~ /([\w\-_\d\.]+)\/([\w\d\-_\.]+)/) {
453
454                # specific case of a file being called in a subdir of current directory
455                my $calledFileSubDir = $1;
456                my $calledFile = $2;
457                # $calledFileSubDir = 'temp'; # FORCE FOR DBG
458                # with the above, for lhc.out of twiss target, we indeed
459                # find the .mad files under 'TEMP', but if we keep the name they disappear
460                # check if the subdir already exists - if not create it
461                my $existsDir = `ls -d $calledFileSubDir | wc -l`;
462
463                my $pwd = `pwd`; chop $pwd;
464                if ($existsDir==1) {
465                } else {
466                        # DBG: where we end-up for specific case of MB.12.mad
467                        mkdir($calledFileSubDir,0777);
468                        # add this dir to the list of input subdirectories that should be transferred from the workdir
469                        # in which the MAD command is executed into the "inputs" directory (otherwise the directory
470                        # would later go under "outputs" and undergo the side-by-side comparison...)
471                        @inputSubdirectories = ( @inputSubdirectories, $calledFileSubDir );
472
473                }
474                # and now do the copy
475                # DBG: we end-up copying MB.12.mad into ./temp
476                # print REPORT_FILE "DIRECTORY: now copying $samplesRootDir/$target/$input into ./$calledFileSubDir\n";
477                if ($sourceSubDir eq ""){
478                        `cp $samplesRootDir/$target/$input ./$calledFileSubDir`;
479                } else {
480                        `cp $samplesRootDir/$target/$sourceSubDir/$input ./$calledFileSubDir`;
481                }
482               
483
484                #    @what = `ls ./$calledFileSubDir`;
485                #   $howMany = scalar(@what);
486                #    print REPORT_FILE "DIRECTORY $howMany contents of $pwd/$calledFileSubDir =\n";
487                #    foreach $line (@what ) { print REPORT_FILE "$line\n"; }
488                # --- above to handle the specific case of twiss lhc.madx
489
490
491                } else {
492                # file to be called in the same directory as the input file
493                # print REPORT_FILE "for target '$target' and test input '$infilename', now copying additional '$input'\n";
494                if ($sourceSubDir eq "") {
495                        `cp $samplesRootDir/$target/$input .`;
496                } else {
497                        `cp $samplesRootDir/$target/$sourceSubDir/$input .`;
498                }
499                } # file to be called located in the same directory as the command's input file
500        }
501
502        }
503
504
505
506        # check whether we should call madx or madxp
507        my $madLink;
508        $_ = $command;
509        /.\/(madxp?)[\s\t]*/;
510        if ($1 eq "madxp") { 
511                $madLink = $madxpLink; 
512                $madProgram = "madxp"; 
513        } else {
514                if ($1 eq "madx") { 
515                        $madLink = $madxLink; 
516                        $madProgram = "madx"; 
517                } else {
518                        $madLink = "."; 
519                        $madProgram = "linkUnknown";
520                }
521        }
522
523        `ln -s $madLink $madProgram`;
524
525        # DBG: for twiss - test 5, MAD.12.mad etc in temp are replaced by MAD.12 etc...
526        # hence temp is removed and rewritten whereas this does not seem to be the case
527        # in the reference directory ... rights?
528       
529        if ($regressionTest ==0) { 
530                # For Makefile_develop and Makefile_nag, we want to see stderr
531                # => also redirect the standard error
532                # by replacing: 'madx(p) < file.madx > file.out'
533                # with:         '(madx(p) <file.madx > file.out) >& stderr_redirected'
534                my $redirectedExecutableCommand = "($executableCommand) >& $stderrFile";
535                $executableCommand = $redirectedExecutableCommand;
536        }
537       
538        $testCaseStartTime = localtime;
539        # run the test
540        `$executableCommand`; 
541        $testCaseEndTime = localtime;
542
543        # retrieve the 'output file' name with a regular expression
544        $_ = $command;
545        /[\s\t]([\w._\d]*).out/;
546        $outfilename = $1 . ".out";
547
548
549        # list all by-product output files
550        @allFilesNow = `ls`; # list of all input + output files after invoking 'mad' command
551       
552        # remove the madx link from the list of files to be moved
553
554        # grow the list of input files with the list of subdirectory so that they move together under 'inputs'
555        foreach $dir (@inputSubdirectories){
556        push (@inputs, $dir);
557        }
558
559        @outputs = ();
560        foreach $file (@allFilesNow){
561        chop $file;
562        $isInput = 0;
563        foreach $input (@inputs){
564                if ($file eq $input) {
565                $isInput =1;
566                }
567        }
568        if (($isInput == 0) && ($file ne "madx") && ($file ne "madxp")) {       
569                # ignore the madx/madxp entries which should stay on top
570                push (@outputs, $file);
571        }
572        } ;
573
574        #DBG
575        my $dbg =1 ;
576        if ($dbg==1){
577        print REPORT_FILE "--- for $testCaseDir ---\n";
578        print REPORT_FILE "list of input files: @inputs\n";
579        print REPORT_FILE "list of output files: @outputs\n";
580        print REPORT_FILE "------------------------\n";
581        }
582
583        # now move inputs and outputs into dedicated subdirectory
584        $inputSubdir = "$localTestDir/$target/$testCaseDir/input";
585        $outputSubdir = "$localTestDir/$target/$testCaseDir/output";
586        mkdir($inputSubdir, 0777) or die "fail to create directory $inputSubdir\n";
587        mkdir($outputSubdir, 0777) or die "fail to create directory $outputSubdir\n";   
588
589        foreach $file (@inputs) { 
590        # SPECIFIC CASE: files that must be stored in the locally stored hierarchy
591        # with MAD call instructions referring to a relative path...
592        $_ = $file;
593        if (/..\//) { next; #skip. Later on should also deal with the case of directories under the test dir...
594                } else {
595                        `mv $file $inputSubdir/`;                         
596                }
597        }
598        foreach $file (@outputs) {`mv $file $outputSubdir/`; }
599
600
601        chdir($outputSubdir) or die "fail to chdir to $outputSubdir\n";
602
603        if ($regressionTest) { # i.e. makefile == Makefile_develop
604                # now compare desired output and actual output
605
606                # let's try to do a blind diff without trying to cure any 'standard' discrepancy
607                $diffResFilename = "DIFFERENCES.txt";
608                open (OUT,">$diffResFilename");
609                foreach $file (@outputs) {
610
611                # specific case: 'temp' entry refers to a temporary file name
612                # (if other files, should be omitted in the same way...)
613                if ($file eq "temp") { next; }
614
615                # specific case: skip Postcript '.ps' and '.eps' files
616                # (eventually Poscript files should be removed from the examples' reference CVS repo)
617                if ($file =~ /\.ps$/) { next; }
618                if ($file =~ /\.eps$/) { next; }
619
620                # check there is always two files to be compared
621                if ($sourceSubDir  eq "") {
622                        $fileCount = `ls $samplesRootDir/$target/$file | wc -l`;
623                        chop $fileCount;
624                } else {
625                        $fileCount =  `ls $samplesRootDir/$target/$sourceSubDir/$file | wc -l`;
626                        chop $fileCount;
627                }
628                if ($fileCount == 0) {
629                        print OUT "# FAIL TO COMPARE $file: no such file for reference => FAILURE\n";
630                        $testReport .="<tr class='omit'><td width=\"70%\">$file</td><td width=\"30%\">no file for reference</td></tr>\n";
631                } else {
632
633                        my $detailsLink;
634                        my $detailsHtmlFile;
635
636                        # specific case when the HTML file name is of the form XX.map or XX.map.htm
637                        # webserver will fail to display the HTML although one can open it form the webfolder...
638                        # to overcome this limitation, we need to juggle with the HTML file name
639                        $_ = $file;
640                        s/\.map$/\.maAap/g;
641                        $f = $_;
642               
643
644                        # handle both cases where there is a $sourceSubDir or not...
645                        $detailsLink = "./details/DiffResult_"."$target"."_"."$testCaseDir"."_"."$f.htm"; # weblink
646                        $detailsHtmlFile = "$htmlRootDir/details/DiffResult_"."$target"."_"."$testCaseDir"."_"."$f.htm"; # deliver             
647               
648                        if ($sourceSubDir eq "") {
649                        $madDiffRes = 
650                                `$localRootDir/MadDiff.pl ./$file $samplesRootDir/$target/$file $detailsHtmlFile`;
651                        } else {
652                        $madDiffRes =
653                                `$localRootDir/MadDiff.pl ./$file $samplesRootDir/$target/$sourceSubDir/$file $detailsHtmlFile`;
654                        }
655
656               
657                        $testReport .= "<tr class='$madDiffRes'><td width=\"70%\">$file</td><td width=\"30%\"><a href=\"$detailsLink\">$madDiffRes</a></td></tr>\n";
658                        print OUT "#COMPARING $file yields $madDiffRes\n";
659                       
660                        # summarize the information in $outcome{$target}
661                        if ($madDiffRes eq 'failure'){
662                                $outcome{$target}='failure';
663                        } else {
664                                if ($madDiffRes eq 'warning'){
665                                        if ($outcome{$target} eq 'success'){
666                                                $outcome{$target}='warning';
667                                        }
668                                        # otherwise, $outcome{$target} shall keep its value
669                                        # whether it is 'success' or 'failure'
670                                }
671                        }
672
673                }
674                }
675                close(OUT);     
676        } else {
677                # what we do to process the outcome of tests
678                # compiled with Makefile_develop and Makefile_nag
679               
680                # info can be either (1) per-file : does it exist or not
681                # or (2) per test-case i.e. [a] do we reach completion in the main output file
682                # and if not, and [b] what is the stderr if any.
683       
684                # let's go for (2), i.e. per $testCaseDir
685               
686                # (1) try to open the output file, according to it show the
687                # cell as green / orange / red for completed / incomplete / absent
688                my $existsOutput = 0;
689                foreach $file (@outputs){
690                        if ($file eq $outfilename) {
691                                $existsOutput = 1;
692                        }
693                }
694               
695                my $finishedNormally = 0;
696                if ($existsOutput) {
697                        # now check whether the output completed normally
698                        open OUTFILE, "<$outputSubdir/$outfilename"; # output just moved
699                        while (<OUTFILE>){
700                                if (/\+[\s\t]+MAD\-X[\s\t]+([\d\.]+)[\s\t]+finished normally[\s\t]+\+/){
701                                        $finishedNormally = 1;
702                                }
703                        }
704                        close OUTFILE; 
705                }
706               
707                my $existsStderr = 0;
708                @stderrFiles = `ls $outputSubdir/$stderrFile`;
709                if (scalar(@stderrFiles) >0) {
710                        # check if not empty
711                        my $linesCount = `wc -l $stderrFile`;
712                        if ($linesCount >0) {
713                                $existsStderr=1;
714                        }
715                }
716               
717                my $outputStatus; # used by CSS to apply font-color on stderr web page
718               
719                if ($existsOutput ==0 ){
720                        $outputStatus = 'failure';
721                } else {
722                        if ($finishedNormally) {
723                                if ($existsStderr) {
724                                        $outputStatus = 'warning';
725                                } else {
726                                        $outputStatus = 'success'; # no link to stderr
727                                }
728                        } else {
729                                $outputStatus = 'failure';
730                        }
731                }
732               
733                # update $outcome{$target}
734                # summarize the information in $outcome{$target}
735                if ($outputStatus eq 'failure'){
736                        $outcome{$target}='failure';
737                } else {
738                        if ($outputStatus eq 'warning'){
739                                if ($outcome{$target} eq 'success'){
740                                        $outcome{$target}='warning';
741                                }
742                                # otherwise, $outcome{$target} shall keep its value
743                                # whether it is 'success' or 'failure'
744                        }
745                }               
746               
747               
748               
749                               
750                # (2) if there is an stderr file, then create an HTML file
751                # and draw a link from the main web page
752
753                # HTML files and links to make stderr viewable from the web
754                my $m;
755                if ($makefile eq "Makefile_develop") {
756                        $m="dev";
757                }
758                if ($makefile eq "Makefile_nag"){
759                        $m="nag";
760                }
761                       
762                # weblink:
763                my $errorLink = "<a href=\"./details/Error_".$m."_".$target."_".$testCaseDir.".htm"."\">$m</a>";
764                # deliver:
765                my $errorHtmlFile = "$htmlRootDir/details/Error_".$m."_".$target."_".$testCaseDir.".htm"; 
766                `touch $errorHtmlFile`; # for the time-being
767               
768               
769                errorWebPage("$outputSubdir/$stderrFile",
770                        $errorHtmlFile,
771                        $outputStatus,
772                        $testCaseStartTime,
773                        $testCaseEndTime);
774               
775                my $key = $target . "_" . $testCaseDir;
776                if ($makefile eq "Makefile_develop") {
777                        $dev{$key}="<td class=\"$outputStatus\">$errorLink</td>";
778                }
779                if ($makefile eq "Makefile_nag"){
780                        $nag{$key}="<td class=\"$outputStatus\">$errorLink</td>";
781                }
782
783
784                       
785        }
786} # tests
787
788        if ($regressionTest) {
789        $testReport .= "</table>\n"; # end of table per target
790        }
791} # targets
792} # for each Makefile_develop, Makefile_nag, Makefile ...
793
794$endTime = localtime;
795
796# we know that at this stage $makefile equals "Makefile" anyway
797# i.e. that we are finally performing regression testing
798
799# create web page
800my $html = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">';
801$html .= "<html>\n";
802$html .= "<head>\n";
803$html .= "<title>MAD test result</title>\n";
804$html .= "<link rel=stylesheet href=\"./MadTestWebStyle.css\" type=\"text/css\">"; 
805# CSS stylesheet
806$html .= "</head>\n";
807$html .= "<!-- automatically generated by the MAD testing script -->\n";
808$html .= "<body>\n";
809$html .= "<p>Test started $startTime, ended $endTime</p>\n";
810$html .= "\n<p>To update example X: \n";
811$html .= "'cvs -d:gserver:isscvs.cern.ch/local/reps/madx-examples checkout madX-examples/REF/X' ";
812$html .= "then modify input files, re-run and commit outputs to the CVS.</p>\n";
813$html .= $testReport;
814$html .= "</body>\n";
815$html .= "</html>\n";
816open(OUTHTML, ">$htmlFile");
817print OUTHTML $html;
818close OUTHTML;
819
820# back to the initial directory
821chdir $localRootDir;
822
823# then send e-mails to the people responsible for the various tests' targets
824if ($debugMode ==0) {
825        foreach $target (@targets){
826                # do we need to notify anyone for this target?
827                if (($outcome{$target} eq 'failure')||($outcome{$target} eq 'warning')){
828                        # retreive the responsible person for each test target
829                        $responsible{$target} = `xsltproc --stringparam what responsible --stringparam target $target ProcessScenario.xsl TestScenario.xml`;   
830                        # retreive e-mail address of the responsible person
831                        my $emailRecipient = $responsible{$target};
832                        my $emailSubject = "MAD Unsucessful test for '$target'";
833                        my $emailContent .= "The test that started on $startTime and completed on $endTime resulted in a $outcome{$target}.\n";
834                        $emailContent .= "See detailed report on:\n";
835                        $emailContent .= "http://test-mad-automation.web.cern.ch/test-mad-automation\n";
836                        $emailContent .= "\nThis e-mail has been sent to you because you are registered as the responsible person for the '$target' package\n";
837                        my $msg = MIME::Lite->new(
838                                From       =>   'Jean-Luc.Nougaret@cern.ch',
839                                'Reply-To' =>   'mad-automation-admin@cern.ch',
840                                To         =>   $emailRecipient,
841                                Cc         =>   'mad-automation-admin@cern.ch',
842                                Subject    =>   $emailSubject,
843                                Data       =>   $emailContent
844                        );
845                        $msg->send;
846                        print REPORT_FILE "sent e-mail to $emailRecipient\n";
847                } else {
848                        # for this targets, all tests were sucessful => no need to notify
849                }
850        }
851}
852print REPORT_FILE "script terminated\n";
853close REPORT_FILE;
854
855sub getListOfDependantFiles {
856my $parentFilename = $_[0];
857my $dependentFileList = "";
858open(IN,$parentFilename);
859
860LINE: while(<IN>){
861        # take into account MAD various ways of reading a file, namely using either "call,file" or "readmytable,file"
862        my $fileRetreival = 0 ;
863        my $childCount = 0;
864        my @childs;
865        # MAD syntax too permissive: hard to grep commands
866        # not left-anchored as can be an action after an 'if'
867        # but make sure it has not been commented (negated !) as is frequently the case...
868
869        if (/^[\s\t]*!/) { next LINE; } # this is a comment (!) - do not bother
870
871        if (/[\s\t]*[Rr][Ee][Aa][Dd][Mm][Yy][Tt][Aa][Bb][Ll][Ee],?[\s\t]*[Ff][Ii][Ll][Ee][\s\t]*=[\s\t]*[\"\']?([\w\._\-\d\/]+)[\"\']?[\s\t]*/){
872        @childs[$childCount++] = $1;
873        $fileRetreival = 1;
874
875        }
876
877        if (/[\s\t]*[Cc][Aa][Ll][Ll],?[\s\t]*[Ff][Ii][Ll][Ee][\s\t]*=[\s\t]*[\"\']?([\w\._\-\d\/]+)[\"\']?[\s\t]*;/) {
878        @childs[$childCount++] = $1;
879        $fileRetreival = 1;
880        }
881       
882        # another way to read a table
883        if (/[\s\t]*[Rr][Ee][Aa][Dd][Tt][Aa][Bb][Ll][Ee],?[\s\t]*[Ff][Ii][Ll][Ee][\s\t]*=[\s\t]*[\"\']?([\w\._\-\d\/]+)[\"\']?[\s\t]*;/){
884        @childs[$childCount++] = $1;
885        $fileRetreival = 1;         
886        }
887
888        # another - rare - instruction that calls a script available in the input directory
889        # along the other input files. Such script must be copied locally along the other
890        # files.
891        # this is for instance the case for the read.magnet.errors perl-script
892        # in twiss/test_5/ or foot
893        if (/[Ss][Yy][Ss][Tt][Ee][Mm][\s\t]*,?[\s\t]*[\"\']([\w\._\-\d]+)[\s\t]*<?[\s\t]*([\w\.\_\-\d\/]*)[\s\t]*>?(.*)[\"\']/){
894                my $cmd=$1;
895                my $arg=$2;
896               
897                if (($cmd =~/mkdir/)||($cmd =~/ls/)||($cmd =~ /cat/)||($cmd =~/rm/)||($cmd =~ /grep/) ||($cmd =~ /echo/) || ($cmd =~ /ln/) || ($cmd =~ /cp/)){
898                        # command invocation, not implying a file call
899               
900                } else {
901               
902                    # ... many other cases like 'mkdir' to be handled before we conclude
903                    # the command corresponds to a file...
904
905                    if (($cmd ne "perl") && ($cmd ne "gnuplot") && ($cmd ne "python")){
906                        @childs[$childCount++] = $cmd; # the command ...
907                    }
908                    if ($arg ne "") {
909                        @childs[$childCount++] = $arg; # as well as its argument if any
910                        # print "found command '$cmd', with input argument '$arg'\n";
911                    }
912
913                    $fileRetreival = 1;
914                }
915            }
916        # NOTE: the above is FRAGILE. In many cases, one might expect the System call
917        # to start with a command not corresponding to a local file in the input dir.
918       
919       
920        # another - rare -  instruction that calls a file from another
921        if (/[\s\t]*sxfread[\s\t]*,?[\s\t]*file[\s\t]*=[\s\t]*[\"\']?([\w\._\-\d\/]+)[\"\']?[\s\t]*;/) {
922        @childs[$childCount++] = $1;
923        $fileRetreival = 1;
924        }
925
926
927        if ($fileRetreival == 1) {
928        #    $child = $1;
929        # before adding this child, make sure it's not already part of the childs the parent depends from
930        foreach $child (@childs) {
931                if ($dependentFileList =~ /$child,/) {
932                        # print REPORT_FILE "'$child' already belonging to dependentFileList '$dependentFileList' => omit insertion\n";
933                } else {
934                        # print REPORT_FILE "add child '$child' to list '$dependentFileList'\n";
935                        $dependentFileList = $dependentFileList . $child . ",";
936                }
937        }
938        }
939}
940close(IN);
941$_ = $dependentFileList ; # output arg
942}
943
944sub errorWebPage {
945        my $errorFile = $_[0];
946        my $htmlFile = $_[1];
947        my $outputStatus = $_[2];
948        my $startTime = $_[3];
949        my $endTime = $_[4];
950        my $contents ="";
951       
952        $contents .= "<table width=\"75%\" border=\"0\">\n";
953        $contents .= "<p>Test started $startTime, ended $endTime.<p>\n";       
954        $contents .= "<tr class=$outputStatus><td width=\"80%\">Contents of stderr</td><td width=\"20%\">$outputStatus</td></tr>\n";
955
956        open(INERROR, "<$errorFile");
957        while (<INERROR>){
958                chop;
959                $contents .= "<tr><td colspan=\"2\">$_</td><tr>\n";
960        }
961        $contents .= "</table>\n";
962        close(INERROR);
963       
964        # create web page
965        my $html = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">';
966        $html .= "<html>\n";
967        $html .= "<head>\n";
968        $html .= "<title>MAD stderr file</title>\n";
969        $html .= "<link rel=stylesheet href=\"../MadTestWebStyle.css\" type=\"text/css\">"; 
970        # CSS stylesheet
971        $html .= "</head>\n";
972        $html .= "<!-- automatically generated by the MAD testing script -->\n";
973        $html .= "<body>\n";
974        $html .= $contents;
975        $html .= "</body>\n";
976        $html .= "</html>\n";
977        open(OUTHTML, ">$htmlFile");
978        print OUTHTML $html;
979        close OUTHTML;
980}
981
Note: See TracBrowser for help on using the repository browser.