view release on metacpan or  search on metacpan

t/19_surrounds.t  view on Meta::CPAN

sub test_one {
   my ($e, $rtests) = @_;

   local *SAVERR; open(SAVERR, ">&STDERR");  # save original STDERR
   local *SAVOUT; open(SAVOUT, ">&STDOUT");  # save original STDOUT
   open(STDOUT, '>'.$outf) or die "Could not create '$outf': $!";
   open(STDERR, '>'.$errf) or die "Could not create '$errf': $!";
   my $status = Test::Harness::runtests(@{$rtests});
   # XXX: Test harness does not like the next two closes.
   # close(STDOUT) or die "error: close STDOUT: $!";
   # close(STDERR) or die "error: close STDERR: $!";
   open(STDERR, ">&SAVERR") or die "error: restore STDERR: $!";
   open(STDOUT, ">&SAVOUT") or die "error: restore STDOUT: $!";
   # XXX: is this necessary to prevent leaks?
   close(SAVOUT) or die "error: close SAVOUT: $!";
   close(SAVERR) or die "error: close SAVERR: $!";

   my $outstr = Acme::EyeDrops::_slurp_tfile($outf);
   my $errstr = Acme::EyeDrops::_slurp_tfile($errf);

   print STDERR "\nstdout of TestHarness::runtests:\n$outstr\n";
   print STDERR "stderr of TestHarness::runtests:\n$errstr\n";

   $status or print "not ";
   ++$itest; print "ok $itest - TestHarness::runtests of $e\n";
}

# --------------------------------------------------

my %attrs = (
   Shape          => 'camel',
   Regex          => 0,
   Compact        => 1,
   TrapEvalDie    => 1,
   InformHandler  => sub {},
   Shape          => 'camel',
   Gap            => 1
);

my @unames = (
   '00_Coffee.t',
   '01_mug.t',
   '02_shatters.t',
   '03_Larry.t',
   '04_Apocalyptic.t',
   '05_Parrot.t',
   '06_not.t',
   '07_a.t',
   '08_hoax.t',
   '09_Gallop.t',
   '10_Ponie.t',
   '11_bold.t',
   '12_Beer.t',
   '13_to.t',
   '14_gulp.t',
   '15_Buffy.t',
   '16_astride.t',
   '17_Orange.t',
   '18_sky.t',
);
my @tests  = map("$base/$_",  @unames);
my @ztests = map("$base/z$_", @unames);

# Generate sightly-encoded versions of test programs (see also gen.t).
for my $i (0..$#unames) {
   $attrs{SourceFile} = $tests[$i];
   # Assume first line is #!/usr/bin/perl (needed for taint mode tests).
   my $s_new = get_first_line($attrs{SourceFile}) . "# This program was generated by $0\n";
   $s_new .= sightly(\%attrs);
   build_file($ztests[$i], $s_new);
}

# --------------------------------------------------
# Run with normal EyeDrops.pm as a speed comparison.

test_one('unsightly EyeDrops.pm, plain tests', \@tests);
test_one('unsightly EyeDrops.pm, generated tests', \@ztests);

# Now run with generated EyeDrops.pm.
{
   local @INC = @INC; unshift(@INC, "$genbase/lib");
   test_one('sightly EyeDrops.pm, plain tests', \@tests);
   test_one('sightly EyeDrops.pm, generated tests', \@ztests);
}

# ----------------------------------------------------

for my $t (@ztests) { unlink($t) or die "error: unlink '$t': $!" }

rm_f_dir($genbase);

unlink($outf) or die "error: unlink '$outf': $!";
unlink($errf) or die "error: unlink '$errf': $!";