ext/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/Recurs.pm

   1 package MakeMaker::Test::Setup::Recurs;
   2
   3 @ISA = qw(Exporter);
   4 require Exporter;
   5 @EXPORT = qw(setup_recurs teardown_recurs);
   6
   7 use strict;
   8 use File::Path;
   9 use File::Basename;
  10 use MakeMaker::Test::Utils;
  11
  12 my %Files = (
  13              'Recurs/Makefile.PL'          => <<'END',
  14 use ExtUtils::MakeMaker;
  15
  16 WriteMakefile(
  17     NAME          => 'Recurs',
  18     VERSION       => 1.00,
  19 );
  20 END
  21
  22              'Recurs/prj2/Makefile.PL'     => <<'END',
  23 use ExtUtils::MakeMaker;
  24
  25 WriteMakefile(
  26     NAME => 'Recurs::prj2',
  27     VERSION => 1.00,
  28 );
  29 END
  30
  31              # Check if a test failure in a subdir causes make test to fail
  32              'Recurs/prj2/t/fail.t'         => <<'END',
  33 #!/usr/bin/perl -w
  34
  35 print "1..1\n";
  36 print "not ok 1\n";
  37 END
  38             );
  39
  40 sub setup_recurs {
  41     setup_mm_test_root();
  42     chdir 'MM_TEST_ROOT:[t]' if $^O eq 'VMS';
  43
  44     while(my($file, $text) = each %Files) {
  45         # Convert to a relative, native file path.
  46         $file = File::Spec->catfile(File::Spec->curdir, split m{\/}, $file);
  47
  48         my $dir = dirname($file);
  49         mkpath $dir;
  50         open(FILE, ">$file") || die "Can't create $file: $!";
  51         print FILE $text;
  52         close FILE;
  53
  54         # ensure file at least 1 second old for makes that assume
  55         # files with the same time are out of date.
  56         my $time = calibrate_mtime();
  57         utime $time, $time - 1, $file;
  58     }
  59
  60     return 1;
  61 }
  62
  63 sub teardown_recurs {
  64     foreach my $file (keys %Files) {
  65         my $dir = dirname($file);
  66         if( -e $dir ) {
  67             rmtree($dir) || return;
  68         }
  69     }
  70     return 1;
  71 }
  72
  73
  74 1;