Gensupp.PL

   1 use strict;
   2 use warnings;
   3
   4 my ($sf) = @ARGV;
   5 exit 1 unless defined $sf;
   6
   7 my $file = './gen.pl';
   8
   9 pipe my $rdr, my $wtr or die "pipe(\$rdr, \$wtr): $!";
  10 my $pid = fork;
  11 if (!defined $pid) {
  12  die "fork(): $!";
  13 } elsif ($pid == 0) {
  14  close $rdr or die "close(\$rdr): $!";
  15  open STDERR, '>&', $wtr or die "open(STDERR, '>&', \$wtr): $!";
  16  exec $^X, '-Mlib=lib', $file;
  17 }
  18 close $wtr or die "close(\$rdr): $!";
  19
  20 my ($supp, $name, $num) = ('', 'perlTestValgrind', 0);
  21 while (<$rdr>) {
  22  s/^\s*#\s//;
  23  next if /^==/;
  24  next if /valgrind/ and /\Q$file\E/;
  25  s/<[^>]+>/$name . ++$num/e;
  26  $supp .= $_;
  27 }
  28 waitpid $pid, 0;
  29
  30 1 while unlink $sf;
  31 open my $out, '>', $sf or die "$!";
  32 print $out $supp;
  33 close $out;