view release on metacpan or  search on metacpan

t/01_mug.t  view on Meta::CPAN

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

# This one used to be OK with -Mstrict but not as of perl 5.8.4.
# Sometimes fails with "Out of memory!" with perl 5.10.0:
# comment out for now.
# $outstr = `$^X -w $tmpf q`;
# $rc = $? >> 8;
# $rc == 0 or print "not ";
# ++$itest; print "ok $itest - 12032 camels quine rc\n";
# $outstr eq $camelprog or print "not ";
# ++$itest; print "ok $itest - 12032 camels quine shape\n";

# $camelprogstr =~ tr/#/Y/;
# This one used to be OK with -Mstrict but not as of perl 5.8.4.
# $outstr = `$^X -w $tmpf Y Y`;
# $rc = $? >> 8;
# $rc == 0 or print "not ";
# ++$itest; print "ok $itest - 12032 camels Y rc\n";
# $outstr eq $camelprogstr or print "not ";
# ++$itest; print "ok $itest - 12032 camels Y shape\n";
# $outstr =~ s/^ //mg;
# $outstr =~ s/ +$//mg;
# $outstr =~ s/\n//; chop $outstr;
# $outstr eq $camel_Y_str or print "not ";
# ++$itest; print "ok $itest - 12032 camels Y shape trail\n";

# -------------------------------------------------
# Test Buffy looking in the mirror example.

my $src = <<'END_SRC_STR';
open$[;chop,($==y===c)>$-&&($-=$=)for@:=<0>;
print$"x-(y---c-$-).reverse.$/for@:
END_SRC_STR
$prog = sightly( { Regex         => 1,
                   Compact       => 1,
                   Shape         => 'buffy2',
                   InformHandler => sub {},
                   SourceString  => $src } );
build_file($tmpf, $prog);
my $buffyprogstr = my $buffyprog = $prog;
$buffyprogstr =~ tr/!-~/#/;

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

# This one used to be OK with -Mstrict but not as of perl 5.16.0.
$outstr = `$^X -w $tmpf`;
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - buffy rc\n";
$outstr =~ tr/!-~/#/;
$outstr eq $buffyprogstr and print "not ";
++$itest; print "ok $itest - buffy shape\n";
$outstr =~ s/ +$//mg;
$outstr =~ s/^.+\n// if $] >= 5.017;   # remove leading use re 'eval' line
$outstr eq $buffymirrorstr or print "not ";
++$itest; print "ok $itest - buffy shape mirror\n";

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

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