tests/CuSkip.pm

   1 package CuSkip;
   2 # Skip a test: emit diag to log and to stderr, and exit 77
   3
   4 # Copyright (C) 2011-2012 Free Software Foundation, Inc.
   5
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 use strict;
  20 use warnings;
  21
  22 our $ME = $0 || "<???>";
  23
  24 # Emit a diagnostic both to stderr and to $stderr_fileno_.
  25 # FIXME: don't hard-code that value (9), since it's already defined in init.cfg.
  26 sub skip ($)
  27 {
  28   my ($msg) = @_;
  29   my $stderr_fileno_ = 9;
  30   warn $msg;
  31   open FH, ">&$stderr_fileno_"
  32     or warn "$ME: failed to dup stderr\n";
  33   print FH $msg;
  34   close FH
  35     or warn "$ME: failed to close FD $stderr_fileno_\n";
  36   exit 77;
  37 }
  38
  39 1;