← Back to branch summary

~drizzle-trunk/drizzle/development

« back to all changes in this revision

Viewing changes to tests/lib/dtr_timer.pl

  • Committer: Stewart Smith
  • Date: 2010-02-22 07:44:37 UTC
  • mfrom: (1283.17.4)
  • mto: (1283.19.1)
  • mto: This revision was merged to the branch mainline in revision 1449.
  • Revision ID: stewart@flamingspork.com-20100222074437-1a9x1n030tbtv1qv
Merged embeddded-innodb-store-table-proto into embedded-innodb-write-row.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/lib/dtr_timer.pl
1
 
# -*- cperl -*-
2
 
# Copyright (C) 2005-2006 MySQL AB
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,
9
 
# but WITHOUT ANY WARRANTY; without even the implied warranty of
10
 
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11
 
# GNU 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  USA
16
 
 
17
 
# This is a library file used by the Perl version of drizzle-test-run,
18
 
# and is part of the translation of the Bourne shell script with the
19
 
# same name.
20
 
 
21
 
use Errno;
22
 
use strict;
23
 
 
24
 
sub dtr_init_timers ();
25
 
sub dtr_timer_start($$$);
26
 
sub dtr_timer_stop($$);
27
 
sub dtr_timer_stop_all($);
28
 
 
29
 
 
30
 
##############################################################################
31
 
#
32
 
#  Initiate the structure shared by all timers
33
 
#
34
 
##############################################################################
35
 
 
36
 
sub dtr_init_timers () {
37
 
  my $timers = { timers => {}, pids => {}};
38
 
  return $timers;
39
 
}
40
 
 
41
 
 
42
 
##############################################################################
43
 
#
44
 
#  Start, stop and poll a timer
45
 
#
46
 
#  As alarm() isn't portable to Windows, we use separate processes to
47
 
#  implement timers.
48
 
#
49
 
##############################################################################
50
 
 
51
 
sub dtr_timer_start($$$) {
52
 
  my ($timers,$name,$duration)= @_;
53
 
 
54
 
  if ( exists $timers->{'timers'}->{$name} )
55
 
  {
56
 
    # We have an old running timer, kill it
57
 
    dtr_warning("There is an old timer running");
58
 
    dtr_timer_stop($timers,$name);
59
 
  }
60
 
 
61
 
 FORK:
62
 
  {
63
 
    my $tpid= fork();
64
 
 
65
 
    if ( ! defined $tpid )
66
 
    {
67
 
      if ( $! == $!{EAGAIN} )           # See "perldoc Errno"
68
 
      {
69
 
        dtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
70
 
        sleep(1);
71
 
        redo FORK;
72
 
      }
73
 
      else
74
 
      {
75
 
        dtr_error("can't fork timer, error: $!");
76
 
      }
77
 
    }
78
 
 
79
 
    if ( $tpid )
80
 
    {
81
 
      # Parent, record the information
82
 
      dtr_verbose("Starting timer for '$name',",
83
 
                  "duration: $duration, pid: $tpid");
84
 
      $timers->{'timers'}->{$name}->{'pid'}= $tpid;
85
 
      $timers->{'timers'}->{$name}->{'duration'}= $duration;
86
 
      $timers->{'pids'}->{$tpid}= $name;
87
 
    }
88
 
    else
89
 
    {
90
 
      # Child, install signal handlers and sleep for "duration"
91
 
 
92
 
      # Don't do the ^C cleanup in the timeout child processes!
93
 
      # There is actually a race here, if we get ^C after fork(), but before
94
 
      # clearing the signal handler.
95
 
      $SIG{INT}= 'DEFAULT';
96
 
 
97
 
      $SIG{TERM}= sub {
98
 
        dtr_verbose("timer $$ woke up, exiting!");
99
 
        exit(0);
100
 
      };
101
 
 
102
 
      $0= "dtr_timer(timers,$name,$duration)";
103
 
      sleep($duration);
104
 
      dtr_verbose("timer $$ expired after $duration seconds");
105
 
      exit(0);
106
 
    }
107
 
  }
108
 
}
109
 
 
110
 
 
111
 
sub dtr_timer_stop ($$) {
112
 
  my ($timers,$name)= @_;
113
 
 
114
 
  if ( exists $timers->{'timers'}->{$name} )
115
 
  {
116
 
    my $tpid= $timers->{'timers'}->{$name}->{'pid'};
117
 
    dtr_verbose("Stopping timer for '$name' with pid $tpid");
118
 
 
119
 
    # FIXME as Cygwin reuses pids fast, maybe check that is
120
 
    # the expected process somehow?!
121
 
    kill(15, $tpid);
122
 
 
123
 
    # As the timers are so simple programs, we trust them to terminate,
124
 
    # and use blocking wait for it. We wait just to avoid a zombie.
125
 
    waitpid($tpid,0);
126
 
 
127
 
    delete $timers->{'timers'}->{$name}; # Remove the timer information
128
 
    delete $timers->{'pids'}->{$tpid};   # and PID reference
129
 
 
130
 
    return 1;
131
 
  }
132
 
 
133
 
  dtr_error("Asked to stop timer '$name' not started");
134
 
}
135
 
 
136
 
 
137
 
sub dtr_timer_stop_all ($) {
138
 
  my $timers= shift;
139
 
 
140
 
  foreach my $name ( keys %{$timers->{'timers'}} )
141
 
  {
142
 
    dtr_timer_stop($timers, $name);
143
 
  }
144
 
  return 1;
145
 
}
146
 
 
147
 
 
148
 
sub dtr_timer_timeout ($$) {
149
 
  my ($timers,$pid)= @_;
150
 
 
151
 
  return "" unless exists $timers->{'pids'}->{$pid};
152
 
 
153
 
  # Got a timeout(the process with $pid is recorded as being a timer)
154
 
  # return the name of the timer
155
 
  return $timers->{'pids'}->{$pid};
156
 
}
157
 
 
158
 
1;