문제

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 ..

도움이 되었습니까?

해결책

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));

다른 팁

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);
라이센스 : CC-BY-SA ~와 함께 속성
제휴하지 않습니다 StackOverflow
scroll top