Pregunta

I'm trying to save error codes by:

#global space
my @retCodes;

#main
sub BuildInit {

    my $actionStr = "";
    my $compStr   = "";

    my @component_dirs;
    my @compToBeBuilt;
    foreach my $comp (@compList) {
        @component_dirs = GetDirs($comp);    #populates @component_dirs
    }

    print "Printing Action List: @actionList\n";

    #---------------------------------------
    #----   Setup Worker Threads  ----------
    for ( 1 .. NUM_WORKERS ) {
        async {
            while ( defined( my $job = $q->dequeue() ) ) {
                worker($job);
            }
        };
    }

    #-----------------------------------
    #----   Enqueue The Work  ----------
    for my $action (@actionList) {
        my $sem = Thread::Semaphore->new(0);
        $q->enqueue( [ $_, $action, $sem ] ) for @component_dirs;

        $sem->down( scalar @component_dirs );
        print "\n------>> Waiting for prior actions to finish up... <<------\n";
    }

    # Nothing more to do - notify the Queue that we're not adding anything else
    $q->end();
    $_->join() for threads->list();

    return 0;
}

#worker
sub worker {
    my ($job) = @_;
    my ( $component, $action, $sem ) = @$job;
    Build( $component, $action );
    $sem->up();
}

#builder method
sub Build {

    my ( $comp, $action ) = @_;
    my $cmd     = "$MAKE $MAKE_INVOCATION_PATH/$comp ";
    my $retCode = -1;

    given ($action) {
        when ("depend") { $cmd .= "$action >nul 2>&1" }    #suppress output
        when ("clean")  { $cmd .= $action }
        when ("build")  { $cmd .= 'l1' }
        when ("link")   { $cmd .= '' }                     #add nothing; default is to link
        default { die "Action: $action is unknown to me." }
    }

    print "\n\t\t*** Performing Action: \'$cmd\' on $comp ***" if $verbose;

    if ( $action eq "link" ) {

        # hack around potential race conditions -- will only be an issue during linking
        my $tries = 1;
        until ( $retCode == 0 or $tries == 0 ) {
            last if ( $retCode = system($cmd) ) == 2;      #compile error; stop trying
            $tries--;
        }
    }
    else {
        $retCode = system($cmd);
    }
    push( @retCodes, ( $retCode >> 8 ) );

    #testing
    if ( $retCode != 0 ) {
        print "\n\t\t*** ERROR IN $comp: $@ !! ***\n";
        print "\t\t*** Action: $cmd -->> Error Level: " . ( $retCode >> 8 ) . "\n";

        #exit(-1);
    }

    return $retCode;
}

Error that gets displayed:

Use of uninitialized value $maxReturnCode in concatenation (.) or string at C:\script.pl line 66, line 415.

I can see from the first line of output though, that I get things like: Return Code: 0 Return Code: 0 Return Code: 2 ..

¿Fue útil?

Solución

The issue here is that the code isn't sharing the array between threads; so because of that, each thread is modifying it's local copy of the array, not the global array as expected. The fix for this problem is to share the variable, and lock it before accessing it during the thread processing:

my @retCodes;
share(@retCodes);

...

#during the thread sub
 lock(@retCodes);
 push(@retCodes, ($retCode>>8));

Otros consejos

Here's a stubbed-out runnable version that you should be able to modify a bit to do what you need:

#!/usr/bin/perl
use strict;
use warnings;
use List::Util 'max';
use threads;

#global space
my @retCodes = ();
share(@retCodes);

sub builder {
  my ($comp, $cmd) = ('builder', 'test');
  for my $retCode (qw/0 0 256/) {
    print "\n\t\tReturn Code: " . ($retCode >>8) . "\n";
    lock(@retCodes);
    push(@retCodes, ($retCode>>8));
  }
}

#main
builder();
# other threads started...
# wait for threads to complete...

printf "Codes: %s\n", join(', ', @retCodes);
my $maxReturnCode = max(@retCodes);
print "Highest Error Code: $maxReturnCode\n"; #<-- crashes with error below

exit($maxReturnCode);
Licenciado bajo: CC-BY-SA con atribución
No afiliado a StackOverflow
scroll top