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