# separate executable and can't simply use eval.
chdir 't' if -d 't';
-@INC = "../lib";
+unshift @INC, "../lib";
$ENV{PERL5LIB} = "../lib";
$|=1;
$switch = $1;
}
my($prog,$expected) = split(/\nEXPECT\n/, $_);
+ open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";
+ print TEST $prog, "\n";
+ close TEST or die "Cannot close $tmpfile: $!";
+
if ($^O eq 'MSWin32') {
- open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1";
+ $results = `.\\perl -I../lib $switch $tmpfile 2>&1`;
}
else {
- open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1";
+ $results = `./perl $switch $tmpfile 2>&1`;
}
- print TEST $prog, "\n";
- close TEST;
$status = $?;
- $results = `$CAT $tmpfile`;
$results =~ s/\n+$//;
+ $results =~ s/at\s+misctmp\d+\s+line/at - line/g;
+ $results =~ s/of\s+misctmp\d+\s+aborted/of - aborted/g;
# bison says 'parse error' instead of 'syntax error',
# various yaccs may or may not capitalize 'syntax'.
$results =~ s/^(syntax|parse) error/syntax error/mig;
EXPECT
a := b := c
########
+use integer;
$cusp = ~0 ^ (~0 >> 1);
$, = " ";
print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n";
EXPECT
-7 0 0 1 !
+-1 0 0 1 !
########
$foo=undef; $foo->go;
EXPECT
EXPECT
Can't call method "ref" without a package or object reference at - line 1.
########
-chop ($str .= <STDIN>);
+chop ($str .= <DATA>);
########
close ($banana);
########
########
system './perl -ne "print if eof" /dev/null'
########
-chop($file = <>);
+chop($file = <DATA>);
########
package N;
sub new {my ($obj,$n)=@_; bless \$n}
########
%@x=0;
EXPECT
-Can't modify hash deref in repeat at - line 1, near "0;"
+Can't modify hash dereference in repeat (x) at - line 1, near "0;"
Execution of - aborted due to compilation errors.
########
$_="foo";
########
/(?{"{"}})/ # Check it outside of eval too
EXPECT
-Unmatched right bracket at (re_eval 1) line 1, at end of line
+Unmatched right curly bracket at (re_eval 1) line 1, at end of line
syntax error at (re_eval 1) line 1, near ""{"}"
Compilation failed in regexp at - line 1.
########
-BEGIN { @ARGV = qw(a b c) }
+BEGIN { @ARGV = qw(a b c d e) }
BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
END { print "end <",shift,">\nargv <@ARGV>\n" }
INIT { print "init <",shift,">\n" }
+CHECK { print "check <",shift,">\n" }
EXPECT
-argv <a b c>
+argv <a b c d e>
begin <a>
-init <b>
-end <c>
-argv <>
+check <b>
+init <c>
+end <d>
+argv <e>
########
-l
# fdopen from a system descriptor to a system descriptor used to close
package X;
sub any { bless {} }
my $f = "FH000"; # just to thwart any future optimisations
-sub afh {
- open(++$f, '>&STDOUT') or die;
- select select $f;
- my $r = *{$f}{IO};
- delete $X::{$f};
- bless $r;
-}
+sub afh { select select ++$f; my $r = *{$f}{IO}; delete $X::{$f}; bless $r }
sub DESTROY { print "destroyed\n" }
package main;
$x = any X; # to bump sv_objcount. IO objs aren't counted??
print $x->foo;
EXPECT
new1new22DESTROY2new33DESTROY31DESTROY1
+########
+re();
+sub re {
+ my $re = join '', eval 'qr/(?p{ $obj->method })/';
+ $re;
+}
+EXPECT
+########
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+EXPECT
+ZZZ
+########
+eval '
+use strict;
+my $foo = "ZZZ\n";
+END { print $foo }
+';
+EXPECT
+ZZZ
+########
+-w
+if (@ARGV) { print "" }
+else {
+ if ($x == 0) { print "" } else { print $x }
+}
+EXPECT
+Use of uninitialized value in numeric eq (==) at - line 4.