Question

我试图通过以下方式保存错误代码：

#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;
}

显示错误：

在连接（。）或中使用未初始化的值$ maxReturnCode 字符串在C：\ script.pl第66行，第415行。

我可以从输出的第一行看到，我得到的结果是：Return Code: 0 Return Code: 0 Return Code: 2 ..

Answer 1

这里的问题是代码不在线程之间共享数组;因此，每个线程都在修改它的数组本地副本，而不是按预期修改全局数组。解决此问题的方法是共享变量，并在线程处理期间锁定它之前将其锁定：

my @retCodes;
share(@retCodes);

...

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

Answer 2

这是一个简化的可运行版本，你应该能够修改一下来做你需要的东西：

#!/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);

多次push（）调用后，int数组仍为undef

2 个答案: