view release on metacpan or  search on metacpan

t/05_Parrot.t  view on Meta::CPAN

$prog = sightly({ Shape         => 'camel',
                  SourceString  => $hellostr,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('Camel helloworld', "hello world\n", $camelstr);

# uml/window helloworld.pl -------------------------

$prog = sightly({ Shape         => 'uml,window',
                  SourceString  => $hellostr,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('uml/window helloworld', "hello world\n", $umlstr . $windowstr);

# uml/window helloworld.pl -------------------------

build_file($tmpeye, $umlstr);
build_file($tmpeye2, $windowstr);

$prog = sightly({ Shape         => 'all',
                  EyeDir        => '.',
                  SourceString  => $hellostr,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('uml/window all helloworld', "hello world\n", $umlstr . $windowstr);

$prog = sightly({ Shape         => 'all',
                  EyeDir        => '.',
                  Width         => 2,
                  SourceString  => $hellostr,
                  InformHandler => sub {},
                  Regex         => 1 } );
test_one('uml/window all width helloworld', "hello world\n",
   $umlstr . "\n\n" . $windowstr);

# Text string print --------------------------------

my $srcstr = "Bill Gates is a pest!\n";
$prog = sightly({ Shape         => 'window',
                  SourceString  => $srcstr,
                  Regex         => 1,
                  InformHandler => sub {},
                  Print         => 1 } );
test_one('Bill Gates is a pest!', $srcstr, $windowstr);

# Text string print (eval) -------------------------

$prog = sightly({ Shape         => 'window',
                  SourceString  => $srcstr,
                  Regex         => 0,
                  InformHandler => sub {},
                  Print         => 1 } );
test_one('Bill Gates is a pest!', $srcstr, $windowstr);

# Binary encode/decode -----------------------------

my $encodestr = qq#binmode(STDOUT);print eval '"'.\n\n\n#;
$encodestr =~ tr/!-~/#/;
$encodestr .= $camelstr x 5;
$srcstr = join("", map(chr(), 0..255));
$prog = sightly({ Shape         => 'camel',
                  SourceString  => $srcstr,
                  Binary        => 1,
                  Regex         => 0,
                  InformHandler => sub {},
                  Print         => 1 } );
build_file($tmpf, $prog);
# This seems to stop on CTRL-Z on Windows!
# Something to do with binmode ??
#   $outstr = `$^X -w -Mstrict $tmpf`;
# so use a temporary file instead.
my $tmpf2 = 'bill2.tmp';
system("$^X -Tw -Mstrict $tmpf >$tmpf2");
my $rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - binary str encode rc\n";
open(TT, $tmpf2) or die "open '$tmpf2': $!";
binmode(TT);
my $outstr = do { local $/; <TT> };
close(TT);
$outstr eq $srcstr or print "not ";
++$itest; print "ok $itest - binary str encode output\n";
$prog =~ tr/!-~/#/;
$prog eq $encodestr or print "not ";
++$itest; print "ok $itest - binary str encode shape\n";

$prog = sightly({ Shape         => 'camel',
                  SourceFile    => $tmpf2,
                  Binary        => 1,
                  Regex         => 0,
                  InformHandler => sub {},
                  Print         => 1 } );
build_file($tmpf, $prog);
system("$^X -Tw -Mstrict $tmpf >$tmpf2");
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - binary file encode rc\n";
open(TT, $tmpf2) or die "open '$tmpf2': $!";
binmode(TT);
$outstr = do { local $/; <TT> };
close(TT);
$outstr eq $srcstr or print "not ";
++$itest; print "ok $itest - binary file encode output\n";
$prog =~ tr/!-~/#/;
$prog eq $encodestr or print "not ";
++$itest; print "ok $itest - binary file encode shape\n";

# Self-printing JAPH -------------------------------

my $src = <<'PROG';
open 0;
$/ = undef;
$x = <0>;
close 0;
$x =~ tr/!-~/#/;
print $x;
PROG
$prog = sightly({ Shape         => 'japh',
                  SourceString  => $src,
                  InformHandler => sub {},