view release on metacpan or  search on metacpan

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

#!/usr/bin/perl
# 01_mug.t (was camel.t)

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

select(STDERR);$|=1;select(STDOUT);$|=1;  # autoflush

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

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

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

# Sometimes tests 4 and 6 fails with "Out of memory!" with perl 5.10.0:
# comment out these tests for now.
# print "1..11\n";
print "1..6\n";

my $camelstr = get_eye_string('camel');
my $camel_Y_str = $camelstr;
$camel_Y_str =~ tr/#/Y/;
my $buffystr = get_eye_string('buffy2');
my $buffymirrorstr = reflect_shape($buffystr);

my $tmpf = 'bill.tmp';

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

my $itest = 0;
my $prog;

# -------------------------------------------------
# Test 12032 camels example.

$prog = sightly( { Regex          => 1,
                   Compact        => 1,
                   RemoveNewlines => 1,
                   BorderGap      => 1,
                   Shape          => 'camel',
                   InformHandler  => sub {},
                   SourceString   => <<'END_SRC_STR' } );
$~=uc shift;$:=pop||'#';open$%;chop(@~=<0>);$~=~R&&
(@~=map{$-=$_+$_;join'',map/.{$-}(.)/,@~}$%..33);
$|--&$~=~H&&next,$~!~Q&&eval"y, ,\Q$:\E,c",$~=~I&&
eval"y, \Q$:\E,\Q$:\E ,",$~=~M&&($_=reverse),
print$~=~V?/(.).?/g:$_,$/for$~=~U?reverse@~:@~
END_SRC_STR
build_file($tmpf, $prog);
my $camelprog = my $camelprogstr = $prog;
$camelprogstr =~ tr/!-~/#/;

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

# 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)
# This one used to be OK with -w but not as of perl 5.16.0.
my $outstr = `$^X $tmpf`;