"Fossies" - the Fresh Open Source Software Archive

Member "Time-HiRes-1.9764/t/Watchdog.pm" (10 Aug 2020, 1929 Bytes) of package /linux/privat/Time-HiRes-1.9764.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 package t::Watchdog;
    2 
    3 use strict;
    4 
    5 use Config;
    6 use Test::More;
    7 
    8 my $waitfor = 360; # 30-45 seconds is normal (load affects this).
    9 my $watchdog_pid;
   10 my $TheEnd;
   11 
   12 if ($Config{d_fork}) {
   13     print("# I am the main process $$, starting the watchdog process...\n");
   14     $watchdog_pid = fork();
   15     if (defined $watchdog_pid) {
   16         if ($watchdog_pid == 0) { # We are the kid, set up the watchdog.
   17             my $ppid = getppid();
   18             print("# I am the watchdog process $$, sleeping for $waitfor seconds...\n");
   19             sleep($waitfor - 2);    # Workaround for perlbug #49073
   20             sleep(2);               # Wait for parent to exit
   21             if (kill(0, $ppid)) {   # Check if parent still exists
   22                 warn "\n$0: overall time allowed for tests (${waitfor}s) exceeded!\n";
   23                 print("Terminating main process $ppid...\n");
   24                 kill('KILL', $ppid);
   25                 print("# This is the watchdog process $$, over and out.\n");
   26             }
   27             exit(0);
   28         } else {
   29             print("# The watchdog process $watchdog_pid launched, continuing testing...\n");
   30             $TheEnd = time() + $waitfor;
   31         }
   32     } else {
   33         warn "$0: fork failed: $!\n";
   34     }
   35 } else {
   36     print("# No watchdog process (need fork)\n");
   37 }
   38 
   39 END {
   40     if ($watchdog_pid) { # Only in the main process.
   41         my $left = $TheEnd - time();
   42         printf("# I am the main process $$, terminating the watchdog process $watchdog_pid before it terminates me in %d seconds (testing took %d seconds).\n", $left, $waitfor - $left);
   43         if (kill(0, $watchdog_pid)) {
   44             local $? = 0;
   45             my $kill = kill('KILL', $watchdog_pid); # We are done, the watchdog can go.
   46             wait();
   47             printf("# kill KILL $watchdog_pid = %d\n", $kill);
   48         }
   49         unlink("ktrace.out"); # Used in BSD system call tracing.
   50         print("# All done.\n");
   51     }
   52 }
   53 
   54 1;