eval.t revision 7c478bd95313f5f23a4c958a745db2134aa03244
#!./perl
print "1..40\n";
eval 'print "ok 1\n";';
eval "\$foo\n = # this is a comment\n'ok 3';";
print $foo,"\n";
eval "\$foo\n = # this is a comment\n'ok 4\n';";
print $foo;
print eval '
$foo =;'; # this tests for a call through yyerror()
print eval '$foo = /'; # this tests for a call through fatal()
print eval '"ok 7\n";';
# calculate a factorial with recursive evals
$foo = 5;
$fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}';
$foo = 5;
$fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
do 'Op.eval'; print $@;
# Test the singlequoted eval optimizer
$i = 11;
for (1..3) {
eval 'print "ok ", $i++, "\n"';
}
eval {
print "ok 14\n";
1;
} || print "ok 15\n$@";
# check whether eval EXPR determines value of EXPR correctly
{
my @b = eval @a;
print $@ ? "not ok 18\n" : "ok 18\n";
my $b;
@a = eval $a;
$_ = eval $a;
eval $a;
$b = 'wrong';
$x = sub {
my $b = "right";
};
&$x();
}
my $b = 'wrong';
my $X = sub {
my $b = "right";
};
&$X();
# check navigation of multiple eval boundaries to find lexicals
my $x = 25;
eval <<'EOT'; die if $@;
print "# $x\n"; # clone into eval's pad
sub do_eval1 {
eval $_[0]; die if $@;
}
$x++;
$x++;
$x++;
# calls from within eval'' should clone outer lexicals
eval <<'EOT'; die if $@;
sub do_eval2 {
eval $_[0]; die if $@;
}
$x++;
$x++;
$x++;
# calls outside eval'' should NOT clone lexicals from called context
$main::x = 'ok';
eval <<'EOT'; die if $@;
# $x unbound here
sub do_eval3 {
eval $_[0]; die if $@;
}
$x++;
$x++;
$x++;
# can recursive subroutine-call inside eval'' see its own lexicals?
sub recurse {
my $l = shift;
if ($l < $x) {
++$l;
eval 'print "# level $l\n"; recurse($l);';
die if $@;
}
else {
print "ok $l\n";
}
}
{
}
$x++;
# do closures created within eval bind correctly?
eval <<'EOT';
sub create_closure {
my $self = shift;
return sub {
print $self;
};
}
$x++;
# does lexical search terminate correctly at subroutine boundary?
{
my $r = "not ok $x\n";
eval 'terminal($r)';
}
$x++;
print $@;
# does scalar eval"" pop stack correctly?
{
my $c = eval "(1,2)x10";
$x++;
}
# return from eval {} should clear $@ correctly
{
my $status = eval {
eval { die };
print "# eval { return } test\n";
return; # removing this changes behavior
};
print "not " if $@;
print "ok $x\n";
$x++;
}
# ditto for eval ""
{
my $status = eval q{
eval q{ die };
print "# eval q{ return } test\n";
return; # removing this changes behavior
};
print "not " if $@;
print "ok $x\n";
$x++;
}