Changeset 3088 in /cluster/svnroot


Ignore:
Timestamp:
Mar 28, 2011 10:33:51 AM (10 years ago)
Author:
leemasa
Message:

Fixing a few merge bugs (#524)

Location:
bccd-ng/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • bccd-ng/trunk/packages/etc/init.d/bccd-passwd

    r2756 r3088  
    3737fi
    3838
     39if [ -f /testmode ]; then
     40        echo "Test mode, no password"
     41        echo "\n\n" | /bin/bccd-passwd-wrapper bccd
     42        update-rc.d ssh defaults
     43        sed -i 's/\/sbin\/getty 38400/\/sbin\/mingetty --autologin bccd/' /etc/inittab
     44        telinit q
     45exit 0
     46fi
     47
    3948# From the original BCCD
    4049
  • bccd-ng/trunk/trees/home/bccd/tests/bccd_test_suite.pl

    r2749 r3088  
    2222# You should have received a copy of the GNU General Public License
    2323# along with this program.  If not, see <http://www.gnu.org/licenses/>.
    24 
    2524#**********************************************************#
    2625#BCCD test suite
     
    2928#with --mail, emails differences to bccd-developers@bccd.net
    3029#**********************************************************#
    31 #**********************************************************#
    3230
    3331use strict;
    34 use File::Path;         #for rmtree
    35 use Getopt::Long;       #for argument parsing
    36 use MIME::Lite;         #for mailing results
     32use File::Path;      #for rmtree
     33use Getopt::Long;    #for argument parsing
     34use MIME::Lite;      #for mailing results
     35use Readonly;
     36use Carp;
     37use POSIX;
     38use File::Basename;
     39use IPC::Open3;
     40
     41Readonly my $SUITE_DIRECTORY => dirname(__FILE__);
     42
     43use lib dirname(__FILE__);
    3744
    3845use bccd_test_suite;
    39 use test_defs;
    4046
    4147#Constants
    42 use constant TRUE => 1;
     48use constant TRUE  => 1;
    4349use 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
     50use constant MB    => 1024 * 1024;
     51
     52Readonly my $DEFAULSE =>
     53  -1;    #The default false value. Overridden by any user input
     54Readonly my $DEFAULT_CONTROL_DIR       => "control";
     55Readonly my $DEFAULT_SCRIPTS_DIRECTORY => 'scripts';
     56Readonly my $DEFAULT_TEST_DIR          => "test";
     57Readonly my $DEFAULT_LIST_DIR          => "test_lists";
     58Readonly my $DEFAULT_SYSTEM_DIR        => "system";
     59Readonly my $DEFAULT_DIFF_DIR          => "tmp";
     60Readonly my $DEFAULT_MAILTO =>
     61  'sleemanmunk@gmail.com';    #the recipient of the summary email
     62Readonly my $DEFAULT_MAIL => FALSE;      #send a summary email?
     63Readonly my $DEFAULT_LIST => 'all';
     64Readonly my $SYSTEM       => 'system';
    5065
    5166#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 
     67my $diffdir    = $DEFAULT_DIFF_DIR;          #the directory in which to keep the
     68                                             #files of differences between
     69                                             #test and control
     70my $buildcontrol                = FALSE;
     71my $controldir                  = $DEFAULT_CONTROL_DIR;
     72my $liberation_drive    = FALSE;
     73my $listdir                     = $DEFAULT_LIST_DIR;
     74my $listfile                    = $DEFAULT_LIST;
     75my $mail                        = $DEFAULT_MAIL;
     76my $mailto                      = $DEFAULT_MAILTO;
     77my $messy                       = FALSE;
     78my $scriptdir                   = $DEFAULT_SCRIPTS_DIRECTORY;
     79my $systemdir                   = $DEFAULT_SYSTEM_DIR;
     80my $testdir                     = $DEFAULT_TEST_DIR;
     81my $verbose                     = $DEFAULSE;
     82my %testargs = ();
     83my @cmd;
     84
     85#***MAIN***#
     86print "Changing Directory to $SUITE_DIRECTORY\n";
     87chdir $SUITE_DIRECTORY or die "Could not change directory:$!";
    6388GetOptions(
    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         );
    74 if ($mail == $DEFAULSE){
    75         if ($mailto ne $DEFAULT_MAILTO){
    76                 $mail = TRUE;
    77         }
    78         else{
    79                 $mail = FALSE;
    80         }
     89    'controldir|cdir|cd=s'              => \$controldir,
     90    'control|c'                         => \$buildcontrol,
     91    'diffdir=s'                         => \$diffdir,
     92    'file|f=s'                          => \$listfile,
     93    'listdir|l=s'                       => \$listdir,
     94    'mail!'                             => \$mail,
     95    'mailto|t=s'                        => \$mailto,
     96    'messy|m'                           => \$messy,
     97    'scriptdir|s=s'                     => \$scriptdir,
     98    'systemdir|s=s'                     => \$systemdir,
     99    'testdir|d=s'                       => \$testdir,
     100    'verbose!'                          => \$verbose,
     101        'arg|testarg|scriptarg=s%'      => \%testargs,
     102);
     103
     104if ( $mail == $DEFAULSE ) {
     105    if ( $mailto ne $DEFAULT_MAILTO ) {
     106        $mail = TRUE;
     107    }
     108    else {
     109        $mail = FALSE;
     110    }
     111}
     112
     113if ( $listfile ne $DEFAULT_LIST
     114    && ( $listdir ne $DEFAULT_TEST_DIR || not $listfile =~ m/^\// ) )
     115{
     116    $listfile = "$listdir/$listfile";
    81117}
    82118
     
    84120#unless --noverbose is specified, in which a successful
    85121#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;
     122if ( ( not $mail ) and ( $verbose == $DEFAULSE ) ) {
     123    $verbose = TRUE;
     124}
     125if ( $verbose == $DEFAULSE ) {
     126    $verbose = FALSE;
    91127}
    92128
    93129#get test list
    94130my @testlist;
    95 if (-r $listfile){
    96     @testlist = bccd_test_suite::read_list($SEPARATOR_STRING,$listfile);       
    97 } else {
     131print "Running listfile $listfile \n";
     132if ( $listfile eq 'all' ) {
     133    @testlist = bccd_test_suite::list_files_recursive($scriptdir);
     134}
     135elsif ( -r $listfile ) {
     136    @testlist = bccd_test_suite::read_list($listfile);
     137}
     138else {
    98139    die "Could not read the list file: $!";
    99140}
    100141
    101142#Set up to build control directory
    102 if ($buildcontrol){
    103     print "Using control directory: $controldir\n";
     143if ($buildcontrol) {
     144    print STDERR "Using control directory: $controldir\n";
    104145    $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";
     146}
     147elsif ( not -e $controldir ) {
     148    croak
     149"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";
    107150}
    108151
    109152#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: $!";
     153if ( -e $testdir ) {
     154    rmtree($testdir)
     155      or croak
     156      "Could not clear existing directory $testdir for replacement: $!";
     157}
     158mkdir($testdir) or croak "Could not make directory $testdir: $!";
     159
     160if ( -e $systemdir ) {
     161    rmtree($systemdir)
     162      or croak
     163      "Could not clear existing directory $systemdir for replacement: $!";
     164}
     165mkdir($systemdir) or croak "Could not make directory $systemdir: $!";
    114166
    115167#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 
     168foreach my $test (@testlist) {
     169    my $test_path = bccd_test_suite::find_by_name( $scriptdir, $test );
     170        my $args = '';
     171        my $run_message = '';
     172       
     173        chomp $test_path;
     174
     175        if (defined $testargs{$test}){
     176                $args = $testargs{$test};
    173177        }
    174178
    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;
     179
     180        if ($verbose){
     181                $run_message = "Running $test, found at $test_path";
     182                if ($args){
     183                        $run_message .= " using argument string $args\n";
     184                } else {
     185                        $run_message .= " using no arguments\n";
    231186                }       
    232187        }
    233 }
     188
     189    if ( -f $test_path and not -x $test_path ) {
     190        chmod 0777, "./$test_path"
     191          or croak "Can't chmod $test_path $!";
     192    }
     193
     194    my $system_script = ( index( $test_path, $SYSTEM ) != -1 );
     195
     196    if ( not $system_script ) {
     197                print $run_message;
     198        system("./$test_path &> $testdir/$test.dat $args");
     199    }
     200    elsif ( not $buildcontrol ) {
     201                print $run_message;
     202        system("./$test_path &> $systemdir/$test.dat $args");
     203    }
     204
     205}
     206
     207my $report;
     208my $details;
     209my $date;
     210
     211#Compare tests to controls
     212if ( not $buildcontrol ) { #Test comparison is unnecessary when building control
     213    if ( -e $diffdir ) {
     214        rmtree $diffdir
     215          or croak "Could not delete existing temporary directory $diffdir: $!";
     216    }
     217
     218    mkdir($diffdir);
     219
     220    #Prepare a report of the mismatches
     221    $details = "Details:\n";
     222
     223    for ( my $i = 0 ; $i < @testlist ; ++$i ) {
     224        my $test = $testlist[$i];
     225        if ( -e "$testdir/$test.dat" and -e "$controldir/$test.dat" ) {
     226
     227            @cmd = ( "diff", "$testdir/$test.dat", "$controldir/$test.dat" );
     228            if ($verbose) {
     229                carp "Running @cmd\n";
     230            }
     231            open( my $DIFF, '-|', @cmd )
     232              or croak "Can't run @cmd: $!\n";
     233            open( my $DIFF_OUT, '>', "$diffdir/$test.diff" )
     234              or croak "Can't open $diffdir/$test.diff for writing: $!\n";
     235            while ( my $line = <$DIFF> ) {
     236                chomp $line;
     237                print $DIFF_OUT "$line\n";
     238            }
     239            close($DIFF);
     240            close($DIFF_OUT);
     241
     242            #take first value from wc -l, the number
     243            my @diff_stat = stat("$diffdir/$test.diff");
     244            if ( !@diff_stat ) {
     245                croak "Can't stat $diffdir/$test.diff: $!\n";
     246            }
     247
     248            if ( $diff_stat[7] > 0 ) {   # Size of file, will be zero if no diff
     249                my $lines_added =
     250                  bccd_test_suite::line_match( "$diffdir/$test.diff", qr{^>} );
     251                my $lines_missing =
     252                  bccd_test_suite::line_match( "$diffdir/$test.diff", qr{^<} );
     253                $report .=
     254                  "$test had " . ( $#{$lines_added} + 1 ) . " lines added, ";
     255                $report .= ( $#{$lines_missing} + 1 ) . " missing";
     256                my $lns_added = join( "\n", @{$lines_added} );
     257                $details .= "Testname: $test\n $lns_added\n";
     258            }
     259            else {
     260                unlink "$testdir/$test.dat";
     261            }
     262        }
     263    }
     264
     265    $date = strftime( '%B %d, %Y %T', localtime );
     266    print "DATE: $date\n";
     267
     268    if ($verbose) {
     269        if ($report) {    #if there were any mismatches
     270            print "$date:\n$report\n\n$details\n";
     271        }
     272        else {
     273            print "$date: No mismatches\n";
     274        }
     275
     276    }
     277}
     278
     279#Prepare mail
     280if ($mail) {
     281    my $type;
     282    my @attachments;
     283    my $subject;
     284    my $text;
     285
     286    my $version = `bccd-version`;
     287
     288    if ($buildcontrol) {    #If building control, mail control dir
     289        @cmd = ( "tar", '-czf', 'control.tgz', $controldir );
     290        if ($verbose) {
     291            carp "Running @cmd\n";
     292        }
     293        system(@cmd);
     294        my $rc = WEXITSTATUS($?);
     295        if ($rc) {
     296            croak "tar failed!\n";
     297        }
     298        $type        = 'multipart/mixed';
     299        @attachments = ('control.tgz');
     300        $subject     = 'BCCD Test Control';
     301        $text        = "BCCD Test Control Data:\n$version";
     302    }
     303    elsif ($report) {    #If there is an error report, mail it
     304
     305        @cmd = ( "tar", '-czf', 'test_results.tgz', $controldir, $testdir,
     306            $diffdir );
     307        if ($verbose) {
     308            carp "Running @cmd\n";
     309        }
     310        system(@cmd);
     311        my $rc = WEXITSTATUS($?);
     312        if ($rc) {
     313            croak "tar failed!\n";
     314        }
     315
     316        @cmd = ( "tar", '-czf', 'system.tgz', $systemdir );
     317        if ($verbose) {
     318            carp "Running @cmd\n";
     319        }
     320        system(@cmd);
     321        $rc = WEXITSTATUS($?);
     322        if ($rc) {
     323            croak "tar failed!\n";
     324        }
     325
     326        $type        = 'multipart/mixed';
     327        @attachments = ( 'test_results.tgz', 'system.tgz' );
     328        $subject     = 'BCCD Test Mismatch';
     329        $text =
     330"On $date, the following tests did not match expected values:\n$version\n$report\n$details";
     331
     332    }
     333    else {
     334        @cmd = ( "tar", '-czf', 'system.tgz', $systemdir );
     335        if ($verbose) {
     336            carp "Running @cmd\n";
     337        }
     338        system(@cmd);
     339        my $rc = WEXITSTATUS($?);
     340        if ($rc) {
     341            croak "tar failed!\n";
     342        }
     343        $type        = 'multipart/mixed';
     344        @attachments = ('system.tgz');
     345        $subject     = 'BCCD Test Success';
     346        $text        = "On $date, the BCCD test returned no errors.\n$version";
     347    }
     348
     349    my %mail = (
     350        "From", '<noreply@bccd.net>', "To", "<$mailto>", "Subject", $subject,
     351        "Type", $type,
     352    );
     353
     354    my $msg = MIME::Lite->new(%mail);
     355
     356    $msg->attach(
     357        Type => 'TEXT',
     358        Data => $text,
     359    );
     360    foreach my $attachment (@attachments) {
     361        $msg->attach(
     362            Type        => 'binary',
     363            Path        => $attachment,
     364            Filename    => $attachment,
     365            Disposition => 'attachment'
     366        );
     367    }
     368
     369    # use Net:SMTP to do the sending
     370    $msg->send('smtp');
     371
     372    # Clean up if not told to be messy
     373    if ( not $messy ) {
     374        unlink 'test_results.tgz';
     375        rmtree $testdir;
     376        rmtree $diffdir;
     377        rmtree $systemdir;
     378    }
     379}
     380
     381
  • bccd-ng/trunk/trees/home/bccd/tests/bccd_test_suite.pm

    r2749 r3088  
    1 #Functions for the Automagic BCCD test suite!
    2 package bccd_test_suite;
    3 
    41# $Id$
    52
     
    2421# along with this program.  If not, see <http://www.gnu.org/licenses/>.
    2522
     23#Functions for the Automagic BCCD test suite!
     24package bccd_test_suite;
    2625use strict;
     26use Carp;
     27use Cwd;
     28use POSIX;
     29use Readonly;
     30
     31Readonly my $SHAREDCODE => ".sharedcode";
     32
     33# Return lines matching a regex
     34sub line_match {
     35    my ( $file, $re ) = @_;
     36    my $lines;
     37
     38    open( my $FILE, '<', $file )
     39      or croak "Can't open $file for reading: $!\n";
     40
     41    while ( my $line = <$FILE> ) {
     42        chomp $line;
     43        if ( $line =~ m{$re} ) {
     44            push( @{$lines}, $line );
     45        }
     46    }
     47
     48    close($FILE);
     49
     50    return $lines;
     51}
     52
     53#XXX
     54# Uses command-line find. Perl's built-in find subroutine
     55# is excessively complex for this simple task
     56sub find_by_name {
     57    my ( $directory, $name ) = @_;
     58
     59    open( PATH, "find $directory -name $name|" )
     60      or croak "could not find script $!";
     61
     62    my $path = <PATH>;
     63
     64    close PATH;
     65    return $path;
     66}
    2767
    2868#Trim function to remove whitespace
    29 sub trim{
    30         my ($string) = @_;
    31         $string =~ s/^\s+//;
    32         $string =~ s/\s+$//;
    33         return $string;
    34 }
    35 
    36 #Output to stdout and to data file
    37 sub output{
    38         my ($OUTPUT, $string) = @_;
    39         print $string;
    40         print $OUTPUT $string;
    41 }
    42 
    43 #Create the shell redirection command to store output from a given test
    44 sub generate_storeOutput{
    45         my ($testdir, $testname) = @_;
    46         my $path = `pwd`;
    47         chop $path;
    48         return ">> $path/$testdir/$testname.dat 2>> $path/$testdir/$testname.dat";
     69sub trim {
     70    my ($string) = @_;
     71    $string =~ s/^\s+//;
     72    $string =~ s/\s+$//;
     73    return $string;
    4974}
    5075
    5176#Collect meaningful information from the syncdir command
    52 sub get_syncdir{
    53         my ($tmpoutput) = @_;
    54         open(FILE, "<$tmpoutput") or die "could not open temporary file: $!";
    55         my $tmp = "";
    56         while ($tmp !~ m/\//){
    57                 $tmp = readline FILE;
    58         }
    59         my $startindex = index($tmp,"/",);
    60         my $endindex = index($tmp," ",$startindex);
    61         my $syncdir = substr($tmp,$startindex,$endindex-1);
    62         close FILE;
    63         return $syncdir;
     77sub get_syncdir {
     78    my ($tmpoutput) = @_;
     79    open( my $FILE, '<', $tmpoutput )
     80      or die "could not open temporary file: $!";
     81    my $tmp = "";
     82    while ( $tmp !~ m/\// ) {
     83        $tmp = readline $FILE;
     84    }
     85    my $startindex = index( $tmp, "/", );
     86    my $endindex = index( $tmp, " ", $startindex );
     87    my $syncdir = substr( $tmp, $startindex, $endindex - 1 );
     88    close $FILE;
     89    return $syncdir;
    6490}
    6591
    6692#Get test list from a file
    67 sub read_list{
    68         my($separator_string,$path)     =       @_;
    69         my @testlist = ();
    70         my @infolist = ();
    71         open(FILE,"<$path") or die "could not open list file: $!";
    72         my $tmp = "";
    73         while (!eof(FILE)){
    74                 $tmp = readline FILE;
    75                
    76                 #cut out comments
    77                 my $commentbegin = index($tmp, '#');
    78                         if ($commentbegin != -1){
    79                                 $tmp = substr($tmp,0,$commentbegin);
    80                         }
    81                 #remove trailing and leading whitespace
    82                         $tmp = trim $tmp;
    83                 #entries beginning with '*' are relegated to the info list
    84                 #that is not compared with the control
    85                         if (substr($tmp,length($tmp)-1) eq "*"){
    86                                 chop $tmp;
    87                                 push (@infolist, $tmp);
    88                         }
    89                         elsif ($tmp ne ""){
    90                                 push (@testlist, $tmp);
    91                         }
    92         }
    93         return @testlist,$separator_string,@infolist;
     93sub read_list {
     94    my ($path) = @_;
     95    my @testlist = ();
     96
     97    open( FILE, '<', $path ) or die "could not open list file: $!";
     98    @testlist = grep( !/^$|^#/, <FILE> );    #Remove empty
     99                                             #and comment lines
     100    close(FILE);
     101
     102    map ( {s/#.*$//} @testlist );
     103    map ( {s/\*//} @testlist );
     104    map ( trim, @testlist );
     105
     106    return @testlist;
    94107}
    95108
    96 sub mpi_test{
    97         (my $testdir, my $testname) = @_;
    98         print "$testdir/$testname.dat\n";
    99         open(my $OUTPUT, ">$testdir/$testname.dat") or die "could not open data file: $!";
    100         my $storeOutput = generate_storeOutput($testdir,$testname);
     109sub list_files_recursive {
     110    my ($directory) = @_;
    101111
    102 ####Start test code####
    103         system("cd ~/$testname                          $storeOutput
    104                         make clean                      $storeOutput
    105                         make                            $storeOutput
    106                         mpirun -np 1 ~/$testname/$testname      $storeOutput
    107                         mpirun -np 2 ~/$testname/$testname      $storeOutput");
    108 #XXX This function is untested from here on.
    109         if (-e "~/machines" and `wc -l ~/machines | awk '{print \$1}'` > 1){
    110                 system("bccd-syncdir . ~/machines       &> tmpoutput");
    111                 system("cat tmpoutput $storeOutput");
     112    open( LIST, "ls -FR1 $directory|" );    #ls ignores files and directories
     113                                            #starting with '.' be sure to mimic
     114                                            #this functionality if you change
     115                                            #this command to not use the shell.
    112116
    113 #get path to temporary directory
    114                 if (-s "tmpoutput"){
    115                         my $tempDirectory = get_syncdir("tmpoutput");
    116                         unlink "tmpoutput";
    117                         system("mpirun -machinefile ~/machines\
    118                                 -np 2 $tempDirectory/$testname  $storeOutput");
    119                 } else {
    120                         output ($OUTPUT, "syncdir error.")
    121                 }
     117    #cut out directories and blank space
     118    my @files = grep ( !/\/$|:$|^$/, <LIST> );
     119    close(LIST);
     120    chomp @files;
    122121
    123         }
    124         else{
    125                 output ($OUTPUT, "Machinefile has too few machines: skipping multiprocessor test\n");
    126         }
    127 ####End test code####
    128         close $OUTPUT
    129 }
     122    @files = map { s/\*$//; $_ } @files;
    130123
    131 
    132 sub get_timestamp {
    133   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
    134   my @months = ("January","February","March","April","May","June","July","August","September","October","November","December");
    135    if ($mon < 10) { $mon = "0$mon"; }
    136    if ($hour < 10) { $hour = "0$hour"; }
    137    if ($min < 10) { $min = "0$min"; }
    138    if ($sec < 10) { $sec = "0$sec"; }
    139    $year=$year+1900;
    140 
    141    return $months[$mon] . ' ' . $mday . ', ' . $year . ' ' . $hour . ':' . $min . ':' . $sec;
     124    return @files;
    142125}
    143126
Note: See TracChangeset for help on using the changeset viewer.