t/test.pm

   1 # (X)Emacs mode: -*- cperl -*-
   2
   3 package test;
   4
   5 =head1 NAME
   6
   7 test - tools for helping in test suites (not including running externalprograms).
   8
   9 =head1 SYNOPSIS
  10
  11   ok evcheck(sub {
  12                open my $fh, '>', 'foo';
  13                print $fh "$_\n"
  14                  for 'Bulgaria', 'Cholet';
  15                close $fh;
  16              }, 'write foo'), 1, 'write foo';
  17
  18 =head1 DESCRIPTION
  19
  20 This package provides some variables, and sets up an environment, for test
  21 scripts, such as those used in F<t/>.
  22
  23 This package does not including running external programs; that is provided by
  24 C<test2.pm>.  This is so that suites not needing that can include only
  25 test.pm, and so not require the presence of C<IPC::Run>.
  26
  27 Setting up the environment includes:
  28
  29 =over 4
  30
  31 =item Prepending F<blib/script> onto the path
  32
  33 =item Pushing the module F<lib/> dir onto the @INC var
  34
  35 For internal C<use> calls.
  36
  37 =item Changing directory to a temporary directory
  38
  39 To avoid cluttering the local dir, and/or allowing the local directory
  40 structure to affect matters.
  41
  42 =item Cleaning up the temporary directory afterwards
  43
  44 Unless TEST_DEBUG is set in the environment.
  45
  46 =back
  47
  48 =cut
  49
  50 # ----------------------------------------------------------------------------
  51
  52 # Pragmas -----------------------------
  53
  54 use 5.00503;
  55 use strict;
  56 use vars qw( @EXPORT_OK );
  57
  58 # Inheritance -------------------------
  59
  60 use base qw( Exporter );
  61
  62 =head2 EXPORTS
  63
  64 The following symbols are exported upon request:
  65
  66 =over 4
  67
  68 =item evcheck
  69
  70 =back
  71
  72 =cut
  73
  74 @EXPORT_OK = qw( evcheck );
  75
  76 # Utility -----------------------------
  77
  78 use Carp                          qw( carp );
  79
  80
  81 $| = 1;
  82
  83 # -------------------------------------
  84 # PACKAGE FUNCTIONS
  85 # -------------------------------------
  86
  87 =head2 evcheck
  88
  89 Eval code, return status
  90
  91 =over 4
  92
  93 =item ARGUMENTS
  94
  95 =over 4
  96
  97 =item code
  98
  99 Coderef to eval
 100
 101 =item name
 102
 103 Name to use in error messages
 104
 105 =back
 106
 107 =item RETURNS
 108
 109 =over 4
 110
 111 =item okay
 112
 113 1 if eval was okay, 0 if not.
 114
 115 =back
 116
 117 =back
 118
 119 =cut
 120
 121 sub evcheck {
 122   my ($code, $name) = @_;
 123
 124   my $ok = 0;
 125
 126   eval {
 127     &$code;
 128     $ok = 1;
 129   }; if ( $@ ) {
 130     carp "Code $name failed: $@\n"
 131       if $ENV{TEST_DEBUG};
 132     $ok = 0;
 133   }
 134
 135   return $ok;
 136 }
 137
 138 # -------------------------------------
 139
 140 # defined further up to use in constants
 141
 142 # ----------------------------------------------------------------------------
 143
 144 =head1 EXAMPLES
 145
 146 Z<>
 147
 148 =head1 BUGS
 149
 150 Z<>
 151
 152 =head1 REPORTING BUGS
 153
 154 Email the author.
 155
 156 =head1 AUTHOR
 157
 158 Martyn J. Pearce C<fluffy@cpan.org>
 159
 160 =head1 COPYRIGHT
 161
 162 Copyright (c) 2001, 2002, 2004 Martyn J. Pearce.  This program is free
 163 software; you can redistribute it and/or modify it under the same terms as
 164 Perl itself.
 165
 166 =head1 SEE ALSO
 167
 168 Z<>
 169
 170 =cut
 171
 172 1; # keep require happy.
 173
 174 __END__