view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

print ($array[0] == 1 ? "ok 3\n" : "not ok 3\n");

@array = ();
$i = 0;
permute { ++$i } @array;
print ($i == 0 ? "ok 4\n" : "not ok 4\n");

@array = ('A'..'E');
my @foo;
permute { @foo = @array; } @array;

my $ok = ( join("", @foo) eq join("", reverse @array) );
print ($ok ? "ok 5\n" : "not ok 5\n");

tie @array, 'TieTest';
permute { $_ = "@array" } @array;
print (TieTest->c() == 600 ? "ok 6\n" : "not ok 6\t# ".TieTest->c()."\n");

untie @array;
@array = (qw/a r s e/);
$i = 0;
permute {eval {goto foo}; ++$i } @array;
if ($@ =~ /^Can't /) {
    print "ok 7\n";
} else {
    foo: print "not ok 7\t# $@\n";
}

print ($i == 24 ? "ok 8\n" : "not ok 8\n");

eval {
  permute {die} @array;
};
print ($@ =~ /^Died/ ? "ok 9\n" : "not ok 9\n");

eval { permute {return;} @array; };
print ($@ eq "" ? "ok 10\n" : "not ok 10\n");

eval { permute {while (1) {return}} @array; };
print ($@ eq "" ? "ok 11\n" : "not ok 11\n");

eval { permute {@array = ()} @array };
print ($@ =~ /^Modification of a read-only/ ?
	"ok 12\n" :
	"not ok 12\n");

if (!defined &Internals::SvREADONLY) {
    print "ok 13\t#skip No SvREADONLY\n";
}
else {
    my @array = (1..10);
    Internals::SvREADONLY(@array, 1);
    eval { permute {} @array };
    print ($@ =~ /^(Modification of|Can't permute) a read-only/ ?
	"ok 13\n" :
	"not ok 13\t# $@\n");
}

my $c;
package TieTest;
sub TIEARRAY  {bless []}
sub FETCHSIZE {5}
sub FETCH     { ++$c; $_[1]}
sub c         {$c}