# Checks if the parser behaves correctly in edge cases
# (including weird syntax errors)
-BEGIN {
- chdir 't' if -d 't';
- @INC = '../lib';
+print "1..112\n";
+
+sub failed {
+ my ($got, $expected, $name) = @_;
+
+ print "not ok $test - $name\n";
+ my @caller = caller(1);
+ print "# Failed test at $caller[1] line $caller[2]\n";
+ if (defined $got) {
+ print "# Got '$got'\n";
+ } else {
+ print "# Got undef\n";
+ }
+ print "# Expected $expected\n";
+ return;
}
-BEGIN { require "./test.pl"; }
-plan( tests => 112 );
+sub like {
+ my ($got, $pattern, $name) = @_;
+ $test = $test + 1;
+ if (defined $got && $got =~ $pattern) {
+ print "ok $test - $name\n";
+ # Principle of least surprise - maintain the expected interface, even
+ # though we aren't using it here (yet).
+ return 1;
+ }
+ failed($got, $pattern, $name);
+}
+
+sub is {
+ my ($got, $expect, $name) = @_;
+ $test = $test + 1;
+ if (defined $expect) {
+ if (defined $got && $got eq $expect) {
+ print "ok $test - $name\n";
+ return 1;
+ }
+ failed($got, "'$expect'", $name);
+ } else {
+ if (!defined $got) {
+ print "ok $test - $name\n";
+ return 1;
+ }
+ failed($got, 'undef', $name);
+ }
+}
eval '%@x=0;';
like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
print "#";
print(
$data{foo});
-pass();
+$test = $test + 1;
+print "ok $test\n";
# Bug #21875
# { q.* => ... } should be interpreted as hash, not block
{
my ($expect, $eval) = split / /, $line, 2;
my $result = eval $eval;
- ok($@ eq '', "eval $eval");
+ is($@, '', "eval $eval");
is(ref $result, $expect ? 'HASH' : '', $eval);
}
# this used to segfault (because $[=1 is optimized away to a null block)
my $x;
$[ = 1 while $x;
- pass();
+ $test = $test + 1;
+ print "ok $test\n";
$[ = 0; # restore the original value for less side-effects
}
{
my $x;
$x = 1 for ($[) = 0;
- pass('optimized assignment to $[ used to segfault in list context');
+ $test = $test + 1;
+ print "ok $test - optimized assignment to \$[ used to segfault in list context\n";
if ($[ = 0) { $x = 1 }
- pass('optimized assignment to $[ used to segfault in scalar context');
+ $test = $test + 1;
+ print "ok $test - optimized assignment to \$[ used to segfault in scalar context\n";
$x = ($[=2.4);
is($x, 2, 'scalar assignment to $[ behaves like other variables');
$x = (($[) = 0);