view release on metacpan or  search on metacpan

t/03_Larry.t  view on Meta::CPAN

$nprog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";

# --------------------------------------------------
# Test with FillerVar = '#'

# Exact fit abc ------------------------------------

$prog = sightly({ Width         => $exact,
                  SourceString  => $srcstr,
                  FillerVar     => '#',
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('Exact fit abc, FillerVar=#', "abc\n", 1);
length($prog) == $exact or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ')' or print "not ";
++$itest; print "ok $itest\n";

# One more  abc ------------------------------------

$prog = sightly({ Width         => $exact+1,
                  SourceString  => $srcstr,
                  FillerVar     => '#',
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('One more abc, FillerVar=#', "abc\n", 1);
length($prog) == $exact+1 or print "not ";
++$itest; print "ok $itest\n";
$last = chop($prog);
$last eq ';' or print "not ";
++$itest; print "ok $itest\n";
$prog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";

# One less  abc ------------------------------------

$prog = sightly({ Width         => $exact-1,
                  SourceString  => $srcstr,
                  FillerVar     => '#',
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('One less abc, FillerVar=#', "abc\n", 2);
@lines = split(/^/, $prog, -1); chop(@lines);
scalar(@lines) == 2 or print "not ";
++$itest; print "ok $itest\n";
$fchar = substr($lines[1], 0, 1);
$fchar eq ')' or print "not ";
++$itest; print "ok $itest\n";
length($prog) == 2*($exact-1)+1 or print "not ";
++$itest; print "ok $itest\n";
$nprog = $lines[0] . $fchar;
$nprog eq $sightlystr or print "not ";
++$itest; print "ok $itest\n";

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

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