The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# 14_gulp.t
# Test new SourceHandle attribute and invalid attributes (new with A::E v1.44).

use strict;
use Acme::EyeDrops qw(sightly get_eye_string);

$|=1;

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

sub build_file {
   my ($f, $d) = @_;
   local *F; open(F, '>'.$f) or die "open '$f': $!";
   print F $d or die "write '$f': $!"; close(F);
}

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

print "1..38\n";

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,
                  Regex         => 1 } );
test_one('1 SourceString', '1', $yanick4str);

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

eval { sightly( { Shape  => 'InvalidShape' } ) };
$@ =~ /InvalidShape/ or print "not ";
++$itest; print "ok $itest - InvalidShape\n";

eval { sightly( { InvalidAttr => 1 } ) };
$@ =~ /invalid parameter 'InvalidAttr'/ or print "not ";
++$itest; print "ok $itest - InvalidAttr\n";

eval {
   sightly({ Shape         => 'yanick4',
             SourceFile    => $hellotestfile,
             SourceHandle  => 1 } );
};
$@ =~ /SourceHandle/ or print "not ";
++$itest; print "ok $itest - InvalidAttrs SourceFile/SourceHandle\n";

eval {
   sightly({ Shape         => 'yanick4',
             SourceFile    => $hellotestfile,
             SourceString  => $helloteststr } );
};
$@ =~ /SourceFile/ or print "not ";
++$itest; print "ok $itest - InvalidAttrs SourceFile/SourceString\n";

eval {
   sightly({ Shape         => 'yanick4',
             SourceHandle  => 1,
             SourceString  => $helloteststr } );
};
$@ =~ /SourceString/ or print "not ";
++$itest; print "ok $itest - InvalidAttrs SourceString/SourceHandle\n";

eval {
   sightly({ Shape         => 'yanick4',
             ShapeString   => '#####' x 42,
             SourceString  => $helloteststr } );
};
$@ =~ /ShapeString/ or print "not ";
++$itest; print "ok $itest - InvalidAttrs Shape/ShapeString\n";

eval {
   sightly({ Width         => 3,
             SourceString  => $helloteststr } );
};
$@ =~ /invalid width/ or print "not ";
++$itest; print "ok $itest - Invalid Width\n";

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

unlink($tmpf) or die "error: unlink '$tmpf': $!";
unlink($hellotestfile) or die "error: unlink '$hellotestfile': $!";
unlink($zerotestfile) or die "error: unlink '$zerotestfile': $!";

# ----------------------------------------------------------------
# Test for file that does not exist.

eval {
   sightly({ Shape         => 'yanick4',
             SourceFile    => $hellotestfile,
             InformHandler => sub {},
             Regex         => 1 } );
};
$@ =~ /'\Q$hellotestfile\E':/ or print "not ";
++$itest; print "ok $itest - Invalid SourceFile, file not found\n";

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