view release on metacpan or  search on metacpan

t/14_gulp.t  view on Meta::CPAN

my $helloteststr = <<'HELLOTEST';
# Just a test.
use strict;
for my $i (0..3) {
   print "hello test $i\n";
}
HELLOTEST
my $hellotestfile = 'hellotest.pl';
my $zerotestfile = '0';
my $yanick4str = get_eye_string('yanick4');
my $tmpf = 'bill.tmp';

build_file($hellotestfile, $helloteststr);
build_file($zerotestfile, $helloteststr);

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

my $itest = 0;
my $prog;

sub test_one {
   my ($e, $ostr, $sh) = @_;
   build_file($tmpf, $prog);
   my $outstr = `$^X -Tw -Mstrict $tmpf`;
   my $rc = $? >> 8;
   $rc == 0 or print "not ";
   ++$itest; print "ok $itest - $e rc\n";
   $outstr eq $ostr or print "not ";
   ++$itest; print "ok $itest - $e output\n";
   $prog =~ tr/!-~/#/;
   $prog =~ s/^.+\n// if $] >= 5.017;   # remove leading use re 'eval' line
   $prog eq $sh or print "not ";
   ++$itest; print "ok $itest - $e shape\n";
}

sub skip_one {
   my $e = shift;
   ++$itest; print "ok $itest # skip $e, rc\n";
   ++$itest; print "ok $itest # skip $e, output\n";
   ++$itest; print "ok $itest # skip $e, shape\n";
}

$prog = sightly({ Shape         => 'yanick4',
                  SourceString  => $helloteststr,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('hellotest SourceString',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

$prog = sightly({ Shape         => 'yanick4',
                  SourceFile    => $hellotestfile,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('hellotest SourceFile string',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

# For different ways to pass a handle, see Perl Cookbook, 2nd edition,
# Recipe 7.5:
#  1) *FH            typeglob
#  2) \*FH           ref to typeglob
#  3) *FH{IO}        I/O object

open(FH, $hellotestfile) or die "error: open '$hellotestfile': $!";
$prog = sightly({ Shape         => 'yanick4',
                  SourceHandle  => *FH,
                  InformHandler => sub {},
                  Regex         => 1 } );
close(FH) or die "error: close '$hellotestfile': $!";
test_one('hellotest SourceHandle typeglob',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

open(FH, $hellotestfile) or die "error: open '$hellotestfile': $!";
$prog = sightly({ Shape         => 'yanick4',
                  SourceHandle  => \*FH,
                  InformHandler => sub {},
                  Regex         => 1 } );
close(FH) or die "error: close '$hellotestfile': $!";
test_one('hellotest SourceHandle typeglob ref',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

open(FH, $hellotestfile) or die "error: open '$hellotestfile': $!";
$prog = sightly({ Shape         => 'yanick4',
                  SourceHandle  => *FH{IO},
                  InformHandler => sub {},
                  Regex         => 1 } );
close(FH) or die "error: close '$hellotestfile': $!";
test_one('hellotest SourceHandle I/O object',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

require IO::File;
my $fh = IO::File->new();
$fh->open($hellotestfile) or die "error: open '$hellotestfile': $!";
$prog = sightly({ Shape         => 'yanick4',
                  SourceHandle  => $fh,
                  InformHandler => sub {},
                  Regex         => 1 } );
$fh->close() or die "error: close '$hellotestfile': $!";
test_one('hellotest SourceHandle IO::File',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

if ($] < 5.006) {
   skip_one("hellotest SourceHandle autovivify, perl version less than 5.006");
} else {
   open(my $fh, $hellotestfile) or die "error: open '$hellotestfile': $!";
   $prog = sightly({ Shape         => 'yanick4',
                     SourceHandle  => $fh,
                     InformHandler => sub {},
                     Regex         => 1 } );
   close($fh) or die "error: close '$hellotestfile': $!";
   test_one('hellotest SourceHandle autovivify',
      "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
      $yanick4str x 3);
}

$prog = sightly({ Shape         => 'yanick4',
                  SourceFile    => $zerotestfile,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('hellotest zero SourceFile string',
   "hello test 0\nhello test 1\nhello test 2\nhello test 3\n",
   $yanick4str x 3);

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

$prog = sightly({ Shape         => 'yanick4',
                  SourceString  => '0',
                  InformHandler => sub {},
                  Print         => 1,
                  Regex         => 1 } );
test_one('0 SourceString', '0', $yanick4str);

$prog = sightly({ Shape         => 'yanick4',
                  SourceString  => '1',
                  InformHandler => sub {},
                  Print         => 1,