X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/774d564bb7dd1ed64ca0d7e534aa67e93f991f02..cc6b73957505a73b130c87add7bf3d534f129041:/t/op/misc.t diff --git a/t/op/misc.t b/t/op/misc.t index 09385b9..7a7fc33 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -1,5 +1,8 @@ #!./perl +# NOTE: Please don't add tests to this file unless they *need* to be run in +# separate executable and can't simply use eval. + chdir 't' if -d 't'; @INC = "../lib"; $ENV{PERL5LIB} = "../lib"; @@ -14,17 +17,24 @@ $tmpfile = "misctmp000"; 1 while -f ++$tmpfile; END { unlink $tmpfile if $tmpfile; } +$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); + for (@prgs){ my $switch; - if (s/^\s*-\w+//){ - $switch = $&; + if (s/^\s*(-\w.*)//){ + $switch = $1; } my($prog,$expected) = split(/\nEXPECT\n/, $_); - open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; + if ($^O eq 'MSWin32') { + open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1"; + } + else { + open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; + } print TEST $prog, "\n"; close TEST; $status = $?; - $results = `cat $tmpfile`; + $results = `$CAT $tmpfile`; $results =~ s/\n+$//; $expected =~ s/\n+$//; if ( $results ne $expected){ @@ -74,7 +84,7 @@ EXPECT ######## eval {sub bar {print "In bar";}} ######## -system "./perl -ne 'print if eof' /dev/null" +system './perl -ne "print if eof" /dev/null' ######## chop($file = <>); ######## @@ -88,7 +98,8 @@ EXPECT ######## %@x=0; EXPECT -Can't coerce HASH to string in repeat at - line 1. +Can't modify hash deref in repeat at - line 1, near "0;" +Execution of - aborted due to compilation errors. ######## $_="foo"; printf(STDOUT "%s\n", $_); @@ -188,6 +199,11 @@ BEGIN failed--compilation aborted at - line 1. shift; print join(' ', reverse @_)."\n"; } + sub PRINTF { + shift; + my $fmt = shift; + print sprintf($fmt, @_)."\n"; + } sub TIEHANDLE { bless {}, shift; } @@ -196,17 +212,36 @@ BEGIN failed--compilation aborted at - line 1. } sub DESTROY { print "and destroyed as well\n"; - } + } + sub READ { + shift; + print STDOUT "foo->can(READ)(@_)\n"; + return 100; + } + sub GETC { + shift; + print STDOUT "Don't GETC, Get Perl\n"; + return "a"; + } } { local(*FOO); tie(*FOO,'foo'); print FOO "sentence.", "reversed", "a", "is", "This"; print "-- ", , " --\n"; + my($buf,$len,$offset); + $buf = "string"; + $len = 10; $offset = 1; + read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed"; + getc(FOO) eq "a" or die "foo->GETC failed"; + printf "%s is number %d\n", "Perl", 1; } EXPECT This is a reversed sentence. -- Out of inspiration -- +foo->can(READ)(string 10 1) +Don't GETC, Get Perl +Perl is number 1 and destroyed as well ######## my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n" @@ -259,6 +294,13 @@ print p::func()->groovy(), "\n" EXPECT really groovy ######## +@list = ([ 'one', 1 ], [ 'two', 2 ]); +sub func { $num = shift; (grep $_->[1] == $num, @list)[0] } +print scalar(map &func($_), 1 .. 3), " ", + scalar(map scalar &func($_), 1 .. 3), "\n"; +EXPECT +2 3 +######## ($k, $s) = qw(x 0); @{$h{$k}} = qw(1 2 4); for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) } @@ -289,3 +331,29 @@ $s = 0; map {#this newline here tickles the bug $s += $_} (1,2,4); print "eat flaming death\n" unless ($s == 7); +######## +sub foo { local $_ = shift; split; @_ } +@x = foo(' x y z '); +print "you die joe!\n" unless "@x" eq 'x y z'; +######## +/(?{"{"})/ # Check it outside of eval too +EXPECT +Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern +/(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1. +######## +/(?{"{"}})/ # Check it outside of eval too +EXPECT +Unmatched right 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 { print "argv <@ARGV>\nbegin <",shift,">\n" } +END { print "end <",shift,">\nargv <@ARGV>\n" } +INIT { print "init <",shift,">\n" } +EXPECT +argv +begin +init +end +argv <>