diff options
Diffstat (limited to 'contrib/perl5/t/op/misc.t')
| -rwxr-xr-x | contrib/perl5/t/op/misc.t | 133 |
1 files changed, 116 insertions, 17 deletions
diff --git a/contrib/perl5/t/op/misc.t b/contrib/perl5/t/op/misc.t index c9050ef..ac1a44f 100755 --- a/contrib/perl5/t/op/misc.t +++ b/contrib/perl5/t/op/misc.t @@ -4,7 +4,7 @@ # separate executable and can't simply use eval. chdir 't' if -d 't'; -@INC = "../lib"; +unshift @INC, "../lib"; $ENV{PERL5LIB} = "../lib"; $|=1; @@ -25,22 +25,25 @@ for (@prgs){ $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; $expected =~ s/\n+$//; - if ( $results ne $expected){ + if ( $results ne $expected ) { print STDERR "PROG: $switch\n$prog\n"; print STDERR "EXPECTED:\n$expected\n"; print STDERR "GOT:\n$results\n"; @@ -56,11 +59,12 @@ $a = ":="; split /($a)/o, "a:=b:=c"; print "@_" 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 @@ -77,7 +81,7 @@ $x=0x0eabcd; print $x->ref; EXPECT Can't call method "ref" without a package or object reference at - line 1. ######## -chop ($str .= <STDIN>); +chop ($str .= <DATA>); ######## close ($banana); ######## @@ -89,7 +93,7 @@ eval {sub bar {print "In bar";}} ######## system './perl -ne "print if eof" /dev/null' ######## -chop($file = <>); +chop($file = <DATA>); ######## package N; sub new {my ($obj,$n)=@_; bless \$n} @@ -101,7 +105,7 @@ EXPECT ######## %@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"; @@ -346,20 +350,22 @@ Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern ######## /(?{"{"}})/ # 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 @@ -433,6 +439,54 @@ foo bar BEGIN failed--compilation aborted at - line 8. ######## +package X; +@ISA='Y'; +sub new { + my $class = shift; + my $self = { }; + bless $self, $class; + my $init = shift; + $self->foo($init); + print "new", $init; + return $self; +} +sub DESTROY { + my $self = shift; + print "DESTROY", $self->foo; +} +package Y; +sub attribute { + my $self = shift; + my $var = shift; + if (@_ == 0) { + return $self->{$var}; + } elsif (@_ == 1) { + $self->{$var} = shift; + } +} +sub AUTOLOAD { + $AUTOLOAD =~ /::([^:]+)$/; + my $method = $1; + splice @_, 1, 0, $method; + goto &attribute; +} +package main; +my $x = X->new(1); +for (2..3) { + my $y = X->new($_); + print $y->foo; +} +print $x->foo; +EXPECT +new1new22DESTROY2new33DESTROY31DESTROY1 +######## +re(); +sub re { + my $re = join '', eval 'qr/(??{ $obj->method })/'; + $re; +} +EXPECT +######## use strict; my $foo = "ZZZ\n"; END { print $foo } @@ -446,3 +500,48 @@ 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. +######## +$x = sub {}; +foo(); +sub foo { eval { return }; } +print "ok\n"; +EXPECT +ok +######## +my @l = qw(hello.* world); +my $x; + +foreach $x (@l) { + print "before - $x\n"; + $x = "\Q$x\E"; + print "quotemeta - $x\n"; + $x = "\u$x"; + print "ucfirst - $x\n"; + $x = "\l$x"; + print "lcfirst - $x\n"; + $x = "\U$x\E"; + print "uc - $x\n"; + $x = "\L$x\E"; + print "lc - $x\n"; +} +EXPECT +before - hello.* +quotemeta - hello\.\* +ucfirst - Hello\.\* +lcfirst - hello\.\* +uc - HELLO\.\* +lc - hello\.\* +before - world +quotemeta - world +ucfirst - World +lcfirst - world +uc - WORLD +lc - world |
