view release on metacpan or  search on metacpan

t/02AutoSplit.t  view on Meta::CPAN

if ($Is_VMS) {
    require VMS::Filespec if $Is_VMS;
    my $vms_unix_rpt;
    my $vms_case;

    $Is_VMS_mode = 1;
    $Is_VMS_lc = 1;
    if (eval 'require VMS::Feature') {
        $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
        $vms_case = VMS::Feature::current("efs_case_preserve");
    } else {
        my $unix_rpt = $ENV{'DECC$FILENAME_UNIX_REPORT'} || '';
        my $efs_case = $ENV{'DECC$EFS_CASE_PRESERVE'} || '';
        $vms_unix_rpt = $unix_rpt =~ /^[ET1]/i; 
        $vms_case = $efs_case =~ /^[ET1]/i;
    }
    $Is_VMS_lc = 0 if ($vms_case);
    $Is_VMS_mode = 0 if ($vms_unix_rpt);
}


require AutoSplit; # Run time. Check it compiles.
ok (1, "AutoSplit loaded");

END {
    use File::Path;
    print "# $incdir being removed...\n";
    rmtree($incdir);
}

mkdir $incdir,0755;

my @tests;
{
  # local this else it buggers up the chomp() below.
  # Hmm. Would be nice to have this as a regexp.
  local $/
    = "################################################################\n";
  @tests = <DATA>;
  close DATA;
}

my $pathsep = $^O eq 'MSWin32' ? '\\' : $^O eq 'MacOS' ? ':' : '/';
my $endpathsep = $^O eq 'MacOS' ? ':' : '';

sub split_a_file {
  my $contents = shift;
  my $file = $_[0];
  if (defined $contents) {
    open FILE, ">$file" or die "Can't open $file: $!";
    print FILE $contents;
    close FILE or die "Can't close $file: $!";
  }

  # Assumption: no characters in arguments need escaping from the shell or perl
  my $com = qq($runperl -e "use AutoSplit; autosplit (qw(@_))");
  print "# command: $com\n";
  # There may be a way to capture STDOUT without spawning a child process, but
  # it's probably worthwhile spawning, as it ensures that nothing in AutoSplit
  # can load functions from split modules into this perl.
  my $output = `$com`;
  warn "Exit status $? from running: >>$com<<" if $?;
  return $output;
}

my $i = 0;
my $dir = File::Spec->catdir($incdir, 'auto');
if ($Is_VMS_mode) {
  $dir = VMS::Filespec::unixify($dir);
  $dir =~ s/\/$//;
} elsif ($^O eq 'MacOS') {
  $dir =~ s/:$//;
}

foreach (@tests) {
  my $module = 'A' . $i . '_' . $$ . 'splittest';
  my $file = File::Spec->catfile($incdir,"$module.pm");
  s/\*INC\*/$incdir/gm;
  s/\*DIR\*/$dir/gm;
  s/\*MOD\*/$module/gm;
  s/\*PATHSEP\*/$pathsep/gm;
  s/\*ENDPATHSEP\*/$endpathsep/gm;
  s#//#/#gm;
  # Build a hash for this test.
  my %args = /^\#\#\ ([^\n]*)\n	# Key is on a line starting ##
             ((?:[^\#]+		# Any number of characters not #
               | \#(?!\#)	# or a # character not followed by #
               | (?<!\n)\#	# or a # character not preceded by \n
              )*)/sgmx;
  foreach ($args{Name}, $args{Require}, $args{Extra}) {
    chomp $_ if defined $_;
  }
  $args{Get} ||= '';

  my @extra_args = !defined $args{Extra} ? () : split /,/, $args{Extra};
  my ($output, $body);
  if ($args{File}) {
    $body ="package $module;\n" . $args{File};
    $output = split_a_file ($body, $file, $dir, @extra_args);
  } else {
    # Repeat tests
    $output = split_a_file (undef, $file, $dir, @extra_args);
  }

  if ($Is_VMS_mode) {
     my ($filespec, $replacement);
     while ($output =~ m/(\[.+\])/) {
       $filespec = $1;
       $replacement =  VMS::Filespec::unixify($filespec);
       $replacement =~ s/\/$//;
       $output =~ s/\Q$filespec\E/$replacement/;
     }
  }

  # test n+1
  is($output, $args{Get}, "Output from autosplit()ing $args{Name}");

  if ($args{Files}) {
    $args{Files} =~ s!/!:!gs if $^O eq 'MacOS';
    my (%missing, %got);