davido, I don't think it is a runaway loop. If it is a run away loop, he should get error "fork didn't work: Resource temporarily unavailable", as sacco only goes to waitpid after all the fork is done.

This has to be a Perl bug. Whatever how bad or how good sacco's code is, it is not direclty managing memory access.

If it is a run away loop, he should get error "fork didn't work: Resource temporarily unavailable"

I'm not going to venture a guess at this point. The error message you suggested doesn't show up in perldiag. And here is the message the original post suggested he's seeing:

I get an error "The instruction at ####### referenced memory at #######. The memory could not be read."

That message also doesn't appear in perldiag.

perlbug states: Check in perldiag to see what any Perl error message(s) mean. If message isn't in perldiag, it probably isn't generated by Perl. Consult your operating system documentation instead.

Since the OP's error message isn't listed in perldiag, I can only assume that it's either generated by a module, or by the operating system. We haven't been told what modules are in use. The original post also doesn't mention what operating system the code is running on. So we know we're not seeing a Perl error (assuming the OP gave us the correct error message), but that's about all we know for sure. The code snippet provided leaves open the possibility of a runaway loop. But it also leaves a lot of other possibilities that need clarification.

No more guesses from me until we get more details. It's probably way premature to assume a Perl bug though. ;)



Dave

"If I had my life to live over again, I'd be a plumber." -- Albert Einstein

What version of perldiag?

Please remember that the messages in perldiag can change a lot from one version of Perl to the next. Looking in perldiag is one occasion where you absolutely want to be sure that you have the right version of perldiag for the right version of Perl, because if you have it wrong, there is a good chance that it isn't there.

"If message isn't in perldiag, it probably isn't generated by Perl. Consult your operating system documentation instead."

Of course it is not a Perl generated message, Perl already crashed upon memory access violation. This is a message generated by operating system, but it is caused by Perl.

"The code snippet provided leaves open the possibility of a runaway loop."

I actually never said that possibility is exculded. What I said is that, run away loop is irrelevent here (The error message does not indicate this). If his code has a run away loop, with the run away loop alone, sacco's code will quickly use up resource and can no longer fork (so his fork will fail, and get the message I mentioned. I saw this message before on both unix and win32 when I forgot to waitpid and kept forking.)

On the other hand, even if it is caused by run away loop, it is still a Perl bug. Perl shall not crash on run away loop.

I did fail to mention that I was running this in Windows XP with Perl 5.6.1. The error message probably stems from the OS as you pointed out, but, I'm thinking that something with Perl is not managing the memory properly.
I tried to copy about 700 files with 5 child processes and it dies with the error message at about 97% completion. I even tried to copy less files (200) - same thing.

Here's the whole code, if it helps:


use Getopt::Long;
use CER::CERIDIAN; #logging purposes
use Text::Tabs;
use Time::Local;
use Tie::IxHash;

use File::Path;
use Win32;
use File::Copy;
use File::DosGlob 'glob';
use Win32::File;
use Win32::AdminMisc;

#------------------Syntax Checking
Configure( \%Config, @ARGV );
if ($Config{help} || !$Config{source} || !$Config{target} || !$Config{
+filemask} || !$Config{thread}){
    Syntax();
    exit 10;
}
if ($Config{log}){
    $log_file = $Config{log};
}else{
    my ($Script) = ($0 =~ /([^\\\/]*?)$/);
    $log_file = "$Script.log";
}
if ($Config{test}){
    CERIDIAN::logentry("flagged as a testmode",$log_file);
    $testmode = 1;
}else{
    $testmode = 0;
}
#------------------Main Body
CERIDIAN::logentry("OPMCOPY started...",$log_file);
print "\nStarting to copy\n";
$source = $Config{source};
$target = $Config{target};
$threads = $Config{thread};
foreach $filemask(@filemasks){
    $fileparm = "$source\\$filemask";
    push(@list,glob($fileparm)); #look into globbing 400 at a time
}
$num_of_files = scalar(@list);
$per_batch = int($num_of_files / $threads);


use warnings;

$| = 1; # turn off buffering
my $pid = $$; # $$ holds the current process ID number
my $parent = 0; # the original process was an immaculate conception
my @kids = (); # no babies yet

FORKER: for ($i = 1; $i <= $threads; $i++){
    my $newpid = fork();
    if ( not defined $newpid ){
        # if return value of fork() is undef, something went wrong
        die "fork didn't work: $!\n";
    }elsif ( $newpid == 0 ){
        # if return value is 0, this is the child process
        $parent = $pid; # which has a parent called $pid
        $pid = $$; # and which will have a new process ID number of it
+s very own
        @kids = (); # the child doesn't want this baggage from the par
+ent
        last FORKER; # and we don't want the child making babies eithe
+r
    }else{
        # the parent process is returned the PID of the newborn by for
+k()
        CERIDIAN::logentry("$$ spawned $newpid",$log_file);
        push @kids, $newpid;
    }
}
if ( $parent ){ # if I have a parent, i.e. if I'm the child process
    do_something();
    exit( 0 );
}else{
    # parent process needs to preside over the death of its kids
    while ( my $kid = shift @kids ){
        CERIDIAN::logentry("Parent waiting for $kid to die",$log_file)
+;
        my $reaped = waitpid( $kid, 0 );
        unless ( $reaped == $kid ){
            CERIDIAN::logentry("Something's up: $?",$log_file);
        }
    }
}

#------------------End Main Body
sub do_something {
    $offset = 0;
    if ($i == $threads){
        $offset = $num_of_files - ($threads*$per_batch);
    }
    $start_point = (($i-1)*$per_batch)+1;
    $end_point = $i*$per_batch + $offset;
    for ($ii = $start_point; $ii <= $end_point; $ii++) {
        if (!$testmode){
            copy "$list[$ii-1]" => "$target";
        }
        CERIDIAN::logentry("copying $list[$ii-1] => $target",$log_file
+);
    }
    return(1);
}

sub Configure
{
    my( $Config, @Args ) = @_;
    my $Result;

    Getopt::Long::Configure( "prefix_pattern=(-|\/)" );
    $Result = GetOptions( $Config, 
                            qw(
                                source|s=s
                                target|d=s
                                filemask|f=s@
                                thread|n=s
                                test|t=s
                                log|l=s
                                help|h|?
                            )
                        );
    $Config->{help} = 1 if( ! $Result );
    push( @filemasks, @{$Config->{filemask}} ) if( scalar @{$Config->{
+filemask}} );
}

sub Syntax {
    my ($Script) = ($0 =~ /([^\\\/]*?)$/);
    my ($Line) = "-" x length($Script);

    print <<EOT;

$Script
$Line


Syntax:
    $Script -s source -d destination -n threadcount -f filemask
                [-f filemask2 [-f filemask3 [...]]]
                [-l log -t testmode]
                [-help | -h | -?]
                
        -s...............Specifies the source directory of files
        -d...............Specifies the target directory to copy to
        -n...............Specifies type number of threads (processes)
                         to split the command into
        -f...............filemask for the copy command
                         Specify as many as needed.
        -l...............log file to write to
        -t...............testmode (doesn't copy anything)
       

Exit Parameters:
    exit 0...............successful completion
    exit 10..............called for help (view syntax)
    exit 20..............unable to open log file

EOT
    
}
[download]