Question

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

Was it helpful?

Solution

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

OTHER TIPS

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);
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top