view release on metacpan or  search on metacpan

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

                  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 {},
                  Regex         => 1 } );
build_file($tmpf, $prog);

# This one used to be OK with -Mstrict but not as of perl 5.8.4.
# From the perl 5.8.4 perldelta:
#   Pragmata are now correctly propagated into (?{...}) constructions in regexps.
#   Code such as
#     my $x = qr{ ... (??{ $x }) ... };
#   will now (correctly) fail under use strict.
#   (As the inner $x is and has always referred to $::x)
$outstr = `$^X -Tw $tmpf`;
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - self-printing japh rc\n";
$outstr =~ s/^.+\n// if $] >= 5.017;   # remove leading use re 'eval' line
$outstr eq $japhstr or print "not ";
++$itest; print "ok $itest - self-printing japh output\n";

# Camel helloworld.pl (FillerVar=';')---------------

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

# Camel helloworld.pl (FillerVar=';#')--------------

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

# Camel helloworld.pl (FillerVar='')----------------

$prog = sightly({ Shape         => 'camel',
                  SourceString  => $hellostr,
                  FillerVar     => '',
                  InformHandler => sub {},
                  Regex         => 1 } );
build_file($tmpf, $prog);
$outstr = `$^X -Tw -Mstrict $tmpf`;
$rc = $? >> 8;
$rc == 0 or print "not ";
++$itest; print "ok $itest - Camel helloworld fillervar= rc\n";
$outstr eq "hello world\n" or print "not ";
++$itest; print "ok $itest - Camel helloworld fillervar= output\n";
$prog =~ s/^use re 'eval';\n// if $] >= 5.017;   # remove leading use re 'eval' line
length($prog) eq 472 or print "not ";