Changeset 3324 in /cluster/svnroot


Ignore:
Timestamp:
Jul 20, 2011 10:14:39 PM (9 years ago)
Author:
skylar
Message:

bad merge in test suite, trying again (#524)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • bccd-ng/branches/skylar-devel/trees/home/bccd/tests/bccd_test_suite.pl

    r3320 r3324  
    66# education.
    77#
    8 # Copyright (C) 2010 Andrew Fitz Gibbon, Paul Gray, Kevin Hunter, Dave Joiner,
     8# Copyright (C) 2011 Andrew Fitz Gibbon, Paul Gray, Kevin Hunter, Dave Joiner,
    99#   Sam Leeman-Munk, Tom Murphy, Charlie Peck, Skylar Thompson, & Aaron Weeden
    1010
     
    3232
    3333use strict;
    34 use File::Path;         #for rmtree
    35 use Getopt::Long;       #for argument parsing
    36 use MIME::Lite;         #for mailing results
     34use File::Path;      #for rmtree
     35use Getopt::Long;    #for argument parsing
     36use MIME::Lite;      #for mailing results
     37use Readonly;
     38use Carp;
     39use POSIX;
     40use File::Basename;
     41use IPC::Open3;
     42
     43Readonly my $SUITE_DIRECTORY => dirname(__FILE__);
     44
     45use lib dirname(__FILE__);
    3746
    3847use bccd_test_suite;
     
    4049
    4150#Constants
    42 use constant TRUE => 1;
     51use constant TRUE  => 1;
    4352use constant FALSE => 0;
    44 my $DEFAULSE = -1; #The default false value. Overridden by any user input
    45 my $SEPARATOR_STRING = "|"; #the string by which to separate one type of tests from another
    46 my $DEFAULT_TEST_DIR = "test";
    47 my $DEFAULT_DIFF_DIR = "tmp";
    48 my $DEFAULT_CONTROL_DIR = "control";
    49 my $DEFAULT_MAILTO = '<sleemanmunk@gmail.com>'; #the recipient of the summary email
     53use constant MB    => 1024 * 1024;
     54
     55Readonly my $DEFAULSE =>
     56  -1;    #The default false value. Overridden by any user input
     57Readonly my $DEFAULT_CONTROL_DIR       => "control";
     58Readonly my $DEFAULT_SCRIPTS_DIRECTORY => 'scripts';
     59Readonly my $DEFAULT_TEST_DIR          => "test";
     60Readonly my $DEFAULT_LIST_DIR          => "test_lists";
     61Readonly my $DEFAULT_SYSTEM_DIR        => "system";
     62Readonly my $DEFAULT_DIFF_DIR          => "tmp";
     63Readonly my $DEFAULT_MAILTO =>
     64  'sleemanmunk@gmail.com';    #the recipient of the summary email
     65Readonly my $DEFAULT_MAIL => $DEFAULSE;      #send a summary email?
     66Readonly my $DEFAULT_LIST => 'all';
     67Readonly my $SYSTEM       => 'system';
    5068
    5169#Global Arguments and Defaults
    52 my $diffdir = $DEFAULT_DIFF_DIR;        #the directory in which to keep the
    53                                         #files of differences between test and control
    54 my $testdir = $DEFAULT_TEST_DIR;
    55 my $controldir = $DEFAULT_CONTROL_DIR;
    56 my $listfile = "test_lists/std";
    57 my $buildcontrol = FALSE;
    58 my $verbose = $DEFAULSE;
    59 my $mail = TRUE;
    60 my $mailto = $DEFAULT_MAILTO;
    61 my $messy = FALSE;
    62 
     70my $diffdir    = $DEFAULT_DIFF_DIR;          #the directory in which to keep the
     71                                             #files of differences between
     72                                             #test and control
     73my $buildcontrol                = FALSE;
     74my $controldir                  = $DEFAULT_CONTROL_DIR;
     75my $liberation_drive    = FALSE;
     76my $listdir                     = $DEFAULT_LIST_DIR;
     77my $listfile                    = $DEFAULT_LIST;
     78my $mail                        = $DEFAULT_MAIL;
     79my $mailto                      = $DEFAULT_MAILTO;
     80my $messy                       = FALSE;
     81my $scriptdir                   = $DEFAULT_SCRIPTS_DIRECTORY;
     82my $systemdir                   = $DEFAULT_SYSTEM_DIR;
     83my $testdir                     = $DEFAULT_TEST_DIR;
     84my $verbose                     = $DEFAULSE;
     85my %testargs = ();
     86my @cmd;
     87
     88#***MAIN***#
     89print "Changing Directory to $SUITE_DIRECTORY\n";
     90chdir $SUITE_DIRECTORY or die "Could not change directory:$!";
    6391GetOptions(
    64         'control|c' => \$buildcontrol,
    65         'controldir|cdir|cd=s' => \$controldir,
    66         'testdir|d=s' => \$testdir,
    67         'diffdir=s' => \$diffdir,
    68         'file|f=s' => \$listfile,
    69         'mail!' => \$mail,
    70         'verbose!' => \$verbose,
    71         'mailto|t=s' => \$mailto,
    72         'messy' => \$messy,
    73         );
     92    'controldir|cdir|cd=s'              => \$controldir,
     93    'control|c'                         => \$buildcontrol,
     94    'diffdir=s'                         => \$diffdir,
     95    'file|f=s'                          => \$listfile,
     96    'listdir|l=s'                       => \$listdir,
     97    'mail!'                             => \$mail,
     98    'mailto|t=s'                        => \$mailto,
     99    'messy|m'                           => \$messy,
     100    'scriptdir|s=s'                     => \$scriptdir,
     101    'systemdir|s=s'                     => \$systemdir,
     102    'testdir|d=s'                       => \$testdir,
     103    'verbose!'                          => \$verbose,
     104        'arg|testarg|scriptarg=s%'      => \%testargs,
     105);
    74106if ($mail == $DEFAULSE){
    75107        if ($mailto ne $DEFAULT_MAILTO){
     
    81113}
    82114
     115if ( $mail == $DEFAULSE ) {
     116    if ( $mailto ne $DEFAULT_MAILTO ) {
     117        $mail = TRUE;
     118    }
     119    else {
     120        $mail = FALSE;
     121    }
     122}
     123
     124if ( $listfile ne $DEFAULT_LIST
     125    && ( $listdir ne $DEFAULT_TEST_DIR || not $listfile =~ m/^\// ) )
     126{
     127    $listfile = "$listdir/$listfile";
     128}
     129
    83130#By default, verbose turns on when mail is turned off
    84131#unless --noverbose is specified, in which a successful
    85132#run of the suite returns no output
    86 if ((not $mail) and ($verbose == $DEFAULSE)){
    87         $verbose = TRUE;
    88 }
    89 if ($verbose == $DEFAULSE){
    90         $verbose = FALSE;
     133if ( ( not $mail ) and ( $verbose == $DEFAULSE ) ) {
     134    $verbose = TRUE;
     135}
     136if ( $verbose == $DEFAULSE ) {
     137    $verbose = FALSE;
    91138}
    92139
    93140#get test list
    94141my @testlist;
    95 if (-r $listfile){
    96     @testlist = bccd_test_suite::read_list($SEPARATOR_STRING,$listfile);       
    97 } else {
     142print "Running listfile $listfile \n";
     143if ( $listfile eq 'all' ) {
     144    @testlist = bccd_test_suite::list_files_recursive($scriptdir);
     145}
     146elsif ( -r $listfile ) {
     147    @testlist = bccd_test_suite::read_list($listfile);
     148}
     149else {
    98150    die "Could not read the list file: $!";
    99151}
    100152
    101153#Set up to build control directory
    102 if ($buildcontrol){
    103     print "Using control directory: $controldir\n";
     154if ($buildcontrol) {
     155    print STDERR "Using control directory: $controldir\n";
    104156    $testdir = $controldir;
    105 } elsif (not -e $controldir){
    106         die "control directory \"$controldir\" does not exist. Please specify an existing control directory or, if you are using this system as the control system, use option -c to create one";
     157}
     158elsif ( not -e $controldir ) {
     159    croak
     160"control directory \"$controldir\" does not exist. Please specify an existing control directory or, if you are using this system as the control system, use option -c to create one";
    107161}
    108162
    109163#initialize test result directory
    110 if (-e $testdir){
    111     rmtree($testdir) or die "Could not clear existing test directory for replacement: $!";
    112 }
    113 mkdir($testdir) or die "Could not make test directory: $!";
     164if ( -e $testdir ) {
     165    rmtree($testdir)
     166      or croak
     167      "Could not clear existing directory $testdir for replacement: $!";
     168}
     169mkdir($testdir) or croak "Could not make directory $testdir: $!";
     170
     171if ( -e $systemdir ) {
     172    rmtree($systemdir)
     173      or croak
     174      "Could not clear existing directory $systemdir for replacement: $!";
     175}
     176mkdir($systemdir) or croak "Could not make directory $systemdir: $!";
    114177
    115178#Run tests and store results
    116 foreach my $test (@testlist){
    117     if ($test ne $SEPARATOR_STRING){
    118         print "$test\n";
    119         $tests::tests{$test}->($testdir,$test);
    120     }
    121 }
    122 
    123 #Compare tests to controls
    124 if ( not $buildcontrol ){ #Test comparison is unnecessary when building control
    125     if (-e $diffdir){
    126                 rmtree $diffdir or die "Could not delete existing temporary directory $diffdir: $!";
    127     }
    128 
    129     mkdir($diffdir);
    130 
    131 #Prepare a report of the mismatches
    132     my $report;
    133         my $details="Details:\n";
    134 
    135     for (my $i = 0; $testlist[$i] ne $SEPARATOR_STRING and $i < @testlist; ++$i){
    136                 my $test = $testlist[$i];
    137                 if (-e "$testdir/$test.dat" or -e "$controldir/$test.dat"){
    138 
    139                         if (-e "$testdir/$test.dat" xor -e "$controldir/$test.dat"){
    140                                 system("touch $testdir/$test.dat $controldir/$test.dat")
    141                                 or die "Error creating $testdir/$test.dat or $controldir/$test.dat: $!";
    142                         }
    143                         system ("diff $testdir/$test.dat $controldir/$test.dat > $diffdir/$test.diff");
    144                         #examine differences, output to file.
    145                                 my @diff_lines_raw #count lines in differences files.
    146                                 = split(/ /,`wc -l $diffdir/$test.diff`);
    147 
    148 #take first value from wc -l, the number
    149                         my $diff_lines = $diff_lines_raw[0];
    150 
    151                         if ($diff_lines > 0){
    152                                 my $added_lines = `grep \"^>\" $diffdir/$test.diff`;
    153                                 my $missing_lines = `grep \"^<\" $diffdir/$test.diff`;
    154                                 my @lines_added = split(/\n/,$added_lines);
    155                                 my $lines_added = @lines_added;
    156                                 my @lines_missing = split(/\n/,$missing_lines);
    157                                 my $lines_missing = @lines_missing;
    158                                 $report .= "$test had $lines_added lines added, $lines_missing missing";
    159                                 $details .="Testname: $test\n" . $added_lines  . "\n";
    160                         }else{
    161                                 unlink "$testdir/$test.dat";
    162                         }
    163                 }
    164     }
    165     my $date = bccd_test_suite::get_timestamp();
    166     if ($verbose){
    167             if ($report){#if there were any mismatches
    168                     print "$date:\n$report\n\n$details\n";
    169             }else{
    170                     print "$date: No mismatches\n";
    171             }
    172 
     179foreach my $test (@testlist) {
     180    my $test_path = bccd_test_suite::find_by_name( $scriptdir, $test );
     181        my $args = '';
     182        my $run_message = '';
     183       
     184        chomp $test_path;
     185
     186        if (defined $testargs{$test}){
     187                $args = $testargs{$test};
    173188        }
    174189
    175 #Prepare mail
    176         if ($mail){
    177                 my $type;
    178                 my $attachment;
    179                 my $subject;
    180                 my $text;
    181 
    182                 if ($report){ #If there is an error report, mail it
    183 
    184                         system("tar -czf test_results.tgz $controldir $testdir $diffdir");
    185 
    186                         $type = 'multipart/mixed';
    187                         $attachment = 'test_results.tgz';
    188                         $subject = 'BCCD Test Mismatch';
    189                         $text = "On $date, the following tests did not match expected values:\n$report\n$details";
    190 
    191                 } else {
    192                         $type = 'TEXT';
    193                         $attachment = '';
    194                         $subject = 'BCCD Test Success';
    195                         $text = "On $date, the BCCD test returned no errors.";
    196                 }
    197 
    198                 my %mail = ("From"    , '<noreply@bccd.net>',
    199                                 "To"      , '<sleemanmunk@gmail.com>',
    200                                 "Subject" , $subject,
    201                                 "Type"    , $type,
    202                                 );
    203 
    204                 unless ($report) {
    205                         $mail{'Data'} = $text;
    206                 }
    207 
    208                 my $msg = MIME::Lite->new( %mail );
    209 
    210                 if ($report){
    211                         $msg->attach(
    212                                         Type     => 'TEXT',
    213                                         Data     => $text,
    214                                         );
    215                         $msg->attach(
    216                                         Type     => 'binary',
    217                                         Path     => $attachment,
    218                                         Filename => $attachment,
    219                                         Disposition => 'attachment'
    220                                         );
    221                 }
    222 
    223 # use Net:SMTP to do the sending
    224                 $msg->send('smtp');
    225 
    226 # Clean up if not told to be messy
    227                 if (not $messy){
    228                         unlink 'test_results.tgz';
    229                         rmtree $testdir;
    230                         rmtree $diffdir;
     190
     191        if ($verbose){
     192                $run_message = "Running $test, found at $test_path";
     193                if ($args){
     194                        $run_message .= " using argument string $args\n";
     195                } else {
     196                        $run_message .= " using no arguments\n";
    231197                }       
    232198        }
    233 }
     199
     200    if ( -f $test_path and not -x $test_path ) {
     201        chmod 0777, "./$test_path"
     202          or croak "Can't chmod $test_path $!";
     203    }
     204
     205    my $system_script = ( index( $test_path, $SYSTEM ) != -1 );
     206
     207    if ( not $system_script ) {
     208                print $run_message;
     209        system("./$test_path &> $testdir/$test.dat $args");
     210    }
     211    elsif ( not $buildcontrol ) {
     212                print $run_message;
     213        system("./$test_path &> $systemdir/$test.dat $args");
     214    }
     215
     216}
     217
     218my $report;
     219my $details;
     220my $date;
     221
     222#Compare tests to controls
     223if ( not $buildcontrol ) { #Test comparison is unnecessary when building control
     224    if ( -e $diffdir ) {
     225        rmtree $diffdir
     226          or croak "Could not delete existing temporary directory $diffdir: $!";
     227    }
     228
     229    mkdir($diffdir);
     230
     231    #Prepare a report of the mismatches
     232    $details = "Details:\n";
     233
     234    for ( my $i = 0 ; $i < @testlist ; ++$i ) {
     235        my $test = $testlist[$i];
     236        if ( -e "$testdir/$test.dat" and -e "$controldir/$test.dat" ) {
     237
     238            @cmd = ( "diff", "$testdir/$test.dat", "$controldir/$test.dat" );
     239            if ($verbose) {
     240                carp "Running @cmd\n";
     241            }
     242            open( my $DIFF, '-|', @cmd )
     243              or croak "Can't run @cmd: $!\n";
     244            open( my $DIFF_OUT, '>', "$diffdir/$test.diff" )
     245              or croak "Can't open $diffdir/$test.diff for writing: $!\n";
     246            while ( my $line = <$DIFF> ) {
     247                chomp $line;
     248                print $DIFF_OUT "$line\n";
     249            }
     250            close($DIFF);
     251            close($DIFF_OUT);
     252
     253            #take first value from wc -l, the number
     254            my @diff_stat = stat("$diffdir/$test.diff");
     255            if ( !@diff_stat ) {
     256                croak "Can't stat $diffdir/$test.diff: $!\n";
     257            }
     258
     259            if ( $diff_stat[7] > 0 ) {   # Size of file, will be zero if no diff
     260                my $lines_added =
     261                  bccd_test_suite::line_match( "$diffdir/$test.diff", qr{^>} );
     262                my $lines_missing =
     263                  bccd_test_suite::line_match( "$diffdir/$test.diff", qr{^<} );
     264                $report .=
     265                  "$test had " . ( $#{$lines_added} + 1 ) . " lines added, ";
     266                $report .= ( $#{$lines_missing} + 1 ) . " missing";
     267                my $lns_added = join( "\n", @{$lines_added} );
     268                $details .= "Testname: $test\n $lns_added\n";
     269            }
     270            else {
     271                unlink "$testdir/$test.dat";
     272            }
     273        }
     274    }
     275
     276    $date = strftime( '%B %d, %Y %T', localtime );
     277    print "DATE: $date\n";
     278
     279    if ($verbose) {
     280        if ($report) {    #if there were any mismatches
     281            print "$date:\n$report\n\n$details\n";
     282        }
     283        else {
     284            print "$date: No mismatches\n";
     285        }
     286
     287    }
     288}
     289
     290#Prepare mail
     291if ($mail) {
     292    my $type;
     293    my @attachments;
     294    my $subject;
     295    my $text;
     296
     297    my $version = `bccd-version`;
     298
     299    if ($buildcontrol) {    #If building control, mail control dir
     300        @cmd = ( "tar", '-czf', 'control.tgz', $controldir );
     301        if ($verbose) {
     302            carp "Running @cmd\n";
     303        }
     304        system(@cmd);
     305        my $rc = WEXITSTATUS($?);
     306        if ($rc) {
     307            croak "tar failed!\n";
     308        }
     309        $type        = 'multipart/mixed';
     310        @attachments = ('control.tgz');
     311        $subject     = 'BCCD Test Control';
     312        $text        = "BCCD Test Control Data:\n$version";
     313    }
     314    elsif ($report) {    #If there is an error report, mail it
     315
     316        @cmd = ( "tar", '-czf', 'test_results.tgz', $controldir, $testdir,
     317            $diffdir );
     318        if ($verbose) {
     319            carp "Running @cmd\n";
     320        }
     321        system(@cmd);
     322        my $rc = WEXITSTATUS($?);
     323        if ($rc) {
     324            croak "tar failed!\n";
     325        }
     326
     327        @cmd = ( "tar", '-czf', 'system.tgz', $systemdir );
     328        if ($verbose) {
     329            carp "Running @cmd\n";
     330        }
     331        system(@cmd);
     332        $rc = WEXITSTATUS($?);
     333        if ($rc) {
     334            croak "tar failed!\n";
     335        }
     336
     337        $type        = 'multipart/mixed';
     338        @attachments = ( 'test_results.tgz', 'system.tgz' );
     339        $subject     = 'BCCD Test Mismatch';
     340        $text =
     341"On $date, the following tests did not match expected values:\n$version\n$report\n$details";
     342
     343    }
     344    else {
     345        @cmd = ( "tar", '-czf', 'system.tgz', $systemdir );
     346        if ($verbose) {
     347            carp "Running @cmd\n";
     348        }
     349        system(@cmd);
     350        my $rc = WEXITSTATUS($?);
     351        if ($rc) {
     352            croak "tar failed!\n";
     353        }
     354        $type        = 'multipart/mixed';
     355        @attachments = ('system.tgz');
     356        $subject     = 'BCCD Test Success';
     357        $text        = "On $date, the BCCD test returned no errors.\n$version";
     358    }
     359
     360    my %mail = (
     361        "From", '<noreply@bccd.net>', "To", "<$mailto>", "Subject", $subject,
     362        "Type", $type,
     363    );
     364
     365    my $msg = MIME::Lite->new(%mail);
     366
     367    $msg->attach(
     368        Type => 'TEXT',
     369        Data => $text,
     370    );
     371    foreach my $attachment (@attachments) {
     372        $msg->attach(
     373            Type        => 'binary',
     374            Path        => $attachment,
     375            Filename    => $attachment,
     376            Disposition => 'attachment'
     377        );
     378    }
     379
     380    # use Net:SMTP to do the sending
     381    $msg->send('smtp');
     382
     383    # Clean up if not told to be messy
     384    if ( not $messy ) {
     385        unlink 'test_results.tgz';
     386        rmtree $testdir;
     387        rmtree $diffdir;
     388        rmtree $systemdir;
     389    }
     390}
     391
     392
Note: See TracChangeset for help on using the changeset viewer.