← Back to branch summary

~ubuntu-branches/ubuntu/trusty/drizzle/trusty

« back to all changes in this revision

Viewing changes to tests/randgen/lib/GenTest/IPC/Process.pm

  • Committer: Package Import Robot
  • Author(s): Dmitrijs Ledkovs
  • Date: 2013-10-29 15:43:40 UTC
  • mfrom: (1.2.12) (2.1.19 trusty-proposed)
  • Revision ID: package-import@ubuntu.com-20131029154340-2gp39el6cv8bwf2o
Tags: 1:7.2.3-2ubuntu1
* Merge from debian, remaining changes:
  - Link against boost_system because of boost_thread.
  - Add required libs to message/include.am
  - Add upstart job and adjust init script to be upstart compatible.
  - Disable -floop-parallelize-all due to gcc-4.8/4.9 compiler ICE
    http://gcc.gnu.org/bugzilla/show_bug.cgi?id=57732

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/randgen/lib/GenTest/IPC/Process.pm
1
 
# Copyright (C) 2010 Sun Microsystems, Inc. All rights reserved.
2
 
# Use is subject to license terms.
3
 
#
4
 
# This program is free software; you can redistribute it and/or modify
5
 
# it under the terms of the GNU General Public License as published by
6
 
# the Free Software Foundation; version 2 of the License.
7
 
#
8
 
# This program is distributed in the hope that it will be useful, but
9
 
# WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11
 
# General Public License for more details.
12
 
#
13
 
# You should have received a copy of the GNU General Public License
14
 
# along with this program; if not, write to the Free Software
15
 
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301
16
 
# USA
17
 
 
18
 
package GenTest::IPC::Process;
19
 
 
20
 
@ISA = qw(GenTest);
21
 
 
22
 
use GenTest;
23
 
use if osWindows(), threads;
24
 
 
25
 
## A Process is a placeholder for an object run in a separate process.
26
 
## The contract assumes that the objects constructor is run in the
27
 
## parent process and the fork is done in Process->start and then
28
 
## obect->run() is invoked.
29
 
 
30
 
use Data::Dumper;
31
 
 
32
 
use strict;
33
 
 
34
 
my %processes;
35
 
 
36
 
use constant PROCESS_OBJECT => 0;
37
 
use constant PROCESS_PID => 1;
38
 
 
39
 
sub new {
40
 
    my $class = shift;
41
 
 
42
 
    return $class->SUPER::new({
43
 
        'object' => PROCESS_OBJECT},@_);
44
 
}
45
 
 
46
 
 
47
 
sub start {
48
 
    my ($self, @args) = @_;
49
 
 
50
 
    if (osWindows()) {
51
 
        my $thr = threads->create(sub{$self->[PROCESS_OBJECT]->run(@args)});
52
 
        $thr->detach();
53
 
        $self->[PROCESS_PID]=$thr->tid();
54
 
        $processes{$thr->tid()} = $self->[PROCESS_OBJECT];
55
 
        say "".(ref $self->[PROCESS_OBJECT])."(".$thr->tid().") started\n";
56
 
    } else {
57
 
        my $pid = fork();
58
 
        if ($pid == 0 ) {
59
 
            ## Forked process
60
 
            $self->[PROCESS_PID]=$$;
61
 
            $self->[PROCESS_OBJECT]->run(@args);
62
 
            say "".(ref $self->[PROCESS_OBJECT])."($$) terminated normally\n";
63
 
            exit 0;
64
 
        } else {
65
 
            say "".(ref $self->[PROCESS_OBJECT])."($pid) started\n";
66
 
            $self->[PROCESS_PID] = $pid;
67
 
            $processes{$pid} = $self->[PROCESS_OBJECT];
68
 
            return $pid;
69
 
        }
70
 
    }
71
 
}
72
 
 
73
 
 
74
 
sub childWait {
75
 
    my (@list) = @_;
76
 
    if (@list < 1) {
77
 
        while (1) {
78
 
            my $pid = wait();
79
 
            last if $pid < 0;
80
 
            print "".(ref $processes{$pid})."($pid) stopped with status $?\n";
81
 
        }
82
 
    } else {
83
 
        my %pids;
84
 
        map {$pids{$_}=1} @list;
85
 
        while ((keys %pids) > 0) {
86
 
            my $pid = wait();
87
 
            last if $pid < 0;
88
 
            print "".(ref $processes{$pid})."($pid) stopped with status $?\n";
89
 
            delete $pids{$pid} if exists $pids{$pid};
90
 
        }
91
 
    }
92
 
}
93
 
 
94
 
sub childWaitStatus {
95
 
    my ($max, @list) = @_;
96
 
    my $status = 0;
97
 
    if (@list < 1) {
98
 
        while (1) {
99
 
            my $pid = wait();
100
 
            last if $pid < 0;
101
 
            $status = $? if $status < $?;
102
 
            print "".(ref $processes{$pid})."($pid) stopped with status $?\n";
103
 
            last if $status >= $max;
104
 
        }
105
 
    } else {
106
 
        my %pids;
107
 
        map {$pids{$_}=1} @list;
108
 
        while ((keys %pids) > 0) {
109
 
            my $pid = wait();
110
 
            last if $pid < 0;
111
 
            $status = $? if $status < $?;
112
 
            print "".(ref $processes{$pid})."($pid) stopped with status $?\n";
113
 
            delete $pids{$pid} if exists $pids{$pid};
114
 
            last if $status >= $max;
115
 
        }
116
 
    }
117
 
}
118
 
 
119
 
sub kill {
120
 
    my ($self) = @_;
121
 
    
122
 
    if (osWindows()) {
123
 
        ## Not sure yet, but the thread will enevtually die dtogether
124
 
        ## with the main program
125
 
    } else {
126
 
        say "Kill ".(ref $processes{$self->[PROCESS_PID]})."(".$self->[PROCESS_PID].")\n";
127
 
        kill(15, $self->[PROCESS_PID]);
128
 
    }
129
 
}
130
 
 
131
 
1;
132
 
 
133